libctgraphics/pol.cpp

   1 /*****************************************************************************
   2 ** FILE IDENTIFICATION
   3 **
   4 **   POL - Problem Oriented Language
   5 **
   6 **  This is part of the CTSim program
   7 **  Copyright (C) 1983-2000 Kevin Rosenberg
   8 **
   9 **  $Id: pol.cpp,v 1.3 2000/12/04 05:36:57 kevin Exp $
  10 **
  11 **  This program is free software; you can redistribute it and/or modify
  12 **  it under the terms of the GNU General Public License (version 2) as
  13 **  published by the Free Software Foundation.
  14 **
  15 **  This program is distributed in the hope that it will be useful,
  16 **  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 **  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 **  GNU General Public License for more details.
  19 **
  20 **  You should have received a copy of the GNU General Public License
  21 **  along with this program; if not, write to the Free Software
  22 **  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  23 ******************************************************************************/
  24 /*                                                                      */
  25 /*----------------------------------------------------------------------*/
  26
  27 #include "ct.h"\r
  28 #include <math.h>
  29 #include <stdio.h>
  30 #include <ctype.h>
  31 #include "ctsupport.h"
  32 #include "pol.h"
  33
  34
  35 static const int HASHSIZE=20;
  36
  37
  38 /* Tables words stored with install() & found with lookup() */
  39 static SYMBOL *skiptable[HASHSIZE];             /* words to ignore and skip */
  40 static SYMBOL *cmdtable[HASHSIZE];              /* pol parameter commands */
  41 static SYMBOL *usertable[HASHSIZE];             /* user defined symbols */
  42
  43 static struct token_st token;                           /* current token */
  44
  45 static struct metachar {
  46     char eoc;           /* end of command character */
  47     char str;           /* string delimiter */
  48     char com;           /* comment character */
  49     char cmd;           /* pol parameter command character */
  50     char prg;           /* program load character */
  51     char con;           /* continuation across newline character */
  52     char out;           /* character that delimits output to terminal */
  53     char ter;           /* character indicates insertion of input from terminal */
  54     char inb;           /* input from graphics device */
  55 } meta;
  56
  57 /* current pol state */
  58
  59 static struct pol_st {
  60     char skipchars[MAXSKIPCHAR];        /* characters to skip */
  61     int nl_eoc;                         /* TRUE if newline character ends a command */
  62     int trace;                          /* TRUE if trace is on */
  63 } pol;
  64
  65 struct key {
  66     char *keyword;
  67     int  code;
  68 };
  69
  70 /* internal codes for pol commands */
  71
  72 #define PC_EOC      1
  73 #define PC_STR      2
  74 #define PC_COM      3
  75 #define PC_CMD      4
  76 #define PC_PRG      5
  77 #define PC_CON      6
  78 #define PC_OUT      7
  79 #define PC_TER      8
  80 #define PC_INB      9
  81 #define PC_NL_EOC  10
  82 #define PC_NL_NEOC 11
  83 #define PC_TRON    12
  84 #define PC_TROFF   13
  85 #define PC_FILE    14
  86 #define PC_DUMP    15
  87
  88 static struct key cmdlist[] = {
  89   {     "eoc",  PC_EOC,},
  90   {     "str",  PC_STR,},
  91   {     "com",  PC_COM,},
  92   {     "cmd",  PC_CMD,},
  93   {     "prg",  PC_PRG,},
  94   {     "con",  PC_CON,},
  95   {     "out",  PC_OUT,},
  96   {     "ter",  PC_TER,},
  97   {     "inb",  PC_INB,},
  98
  99   {     "nl_eoc",PC_NL_EOC,},
 100   {     "nl_neoc", PC_NL_NEOC,},
 101   {     "tron",  PC_TRON,},
 102   {     "troff", PC_TROFF,},
 103   {     "file",  PC_FILE,},
 104   {     "dump",  PC_DUMP,},
 105 };
 106
 107 #define NUMCMD  (sizeof(cmdlist) / sizeof (struct key))
 108
 109 static int skiptok(char term[]);
 110 static int pol_tok(struct token_st *token);
 111 static void dumptok(struct token_st *token);
 112
 113
 114 static int getpol_tok(struct token_st *token);
 115 static int getcmd(void);
 116 static int gettok (TOKEN *tok);
 117 static void getblank(char *s, int toksiz);
 118 static int getalpha(char *s, int toksiz);
 119 static void getquote(char *qs, int toksiz);
 120 static void getescape(char *s, int delim, int toksiz);
 121 static int getnumber (char str[], int strsize, double *fnum, int *inum);
 122 static void eatline(void);
 123 static int type(int c);
 124 static void inittable(SYMBOL *table[]);
 125 static void freetable(SYMBOL *table[]);
 126 static int hash(char *s);
 127 static SYMBOL *lookup(SYMBOL *table[], char *s);
 128 static SYMBOL *install(SYMBOL *table[], char *s, int def);
 129 static void synerr(char *msg);
 130 static int pol_getch(FILE *fp);
 131
 132
 133 void pol_init (void)
 134 {
 135         meta.eoc    = SEMICOL;
 136         meta.str    = DQUOTE;
 137         meta.com    = SHARP;
 138         meta.cmd    = EXCLAM;
 139         meta.prg    = ATSIGN;
 140         meta.con    = AMPERSAND;
 141         meta.out    = DOLLAR;
 142         meta.ter    = PERCENT;
 143         meta.inb    = LBRACK;
 144
 145         pol.nl_eoc = TRUE;
 146         pol.skipchars[0] = EOS;
 147
 148         inittable (cmdtable);           /* initialize symbol tables */
 149         inittable (usertable);
 150         inittable (skiptable);
 151
 152         for (unsigned int i = 0; i < NUMCMD; i++)
 153             install (cmdtable, cmdlist[i].keyword, cmdlist[i].code);
 154
 155         token.ready = FALSE;            /* no token read yet */
 156 }
 157
 158 /* pol_skpword (w)
 159  *
 160  * char *w - word for pol to ignore and skip over in input
 161  *
 162  * pol_tok() compares all tokens to words given to this routine. If it finds it,
 163  * it will immediately read another token.
 164  */
 165
 166 void
 167 pol_skpword (char *w)
 168 {
 169         if (install (skiptable, w, 0) == NULL)
 170             sys_error (ERR_SEVERE, "Too many skip words defined");
 171 }
 172
 173 /* pol_skpchar (s)
 174  *
 175  * skip all characters that appear in string s
 176  */
 177 void
 178 pol_skpchar (char *s)
 179 {
 180         strncpy (pol.skipchars, s, MAXSKIPCHAR);
 181 }
 182
 183 /* pol_install (str, code)
 184  *
 185  * char *str - token string to install
 186  * int code  - code to return for token
 187  *
 188  * pol_tok() looks for these user defined tokens.  If it finds one,
 189  * it stores the tokens code in the token structure and returns TT_USERTOK
 190  */
 191 int
 192 pol_install (char *str, int code)
 193 {
 194     if (install (usertable, str, code) == NULL)
 195         {
 196             synerr ("Out ot memory installing user tokens");
 197             return (FALSE);
 198         }
 199
 200     return(TRUE);
 201 }
 202
 203 /* get_word - matches tokens on a letter by letter basis
 204  *
 205  * char *search - string to search for
 206  * int  nlet    - maximum number of chars to search for match
 207  */
 208
 209 int
 210 pol_word (char *search, int nlet)
 211 {
 212         pol_tok (&token);
 213         if (pol.trace == TRUE)
 214             printf ("matching current token %s against word %s\n", token.tokstr, search);
 215
 216         if (strncasecmp (search, token.tokstr, nlet) == 0) {
 217             dumptok (&token);
 218             return (TRUE);
 219         } else
 220             return (FALSE);
 221 }
 222
 223 /* pol_usertok (str,code)
 224  *      see if current token is a user defined token set with pol_install()
 225  *
 226  *    char *str - token string as read from input
 227  *    int *code - returned code for user defined symbol
 228  *    return value - TRUE if current token has been user defined
 229  *                   FALSE if current token is not user defined
 230  */
 231 int
 232 pol_usertok (char *str, int *code)
 233 {
 234         pol_tok (&token);
 235
 236         if (pol.trace == TRUE)
 237             printf ("checking if current token '%s' is user defined\n", token.tokstr);
 238
 239         if (token.type == TT_USERTOK) {
 240             *code = token.code;
 241             strcpy (str, token.tokstr);
 242             dumptok (&token);
 243             return (TRUE);
 244         } else {
 245             *code = 0;
 246             return (FALSE);
 247         }
 248 }
 249
 250 /* isstring (s) - returns TRUE if current token is a string
 251  *
 252  * char *s - pointer to place to store token string
 253 */
 254
 255 int
 256 pol_string (char *str)
 257 {
 258         pol_tok (&token);
 259
 260         if (token.type == TT_STRING) {
 261             strcpy (str, token.tokstr);
 262             dumptok (&token);
 263             return (TRUE);
 264         } else
 265             return (FALSE);
 266 }
 267
 268 /* pol_integer - test for an integer
 269  *
 270  * int *n:      returned integer value
 271  * int typecode = TT_INT if accept only integer values
 272  *              = TT_REAL if accept both real and integer values
 273  * int boundcode= TRUE if force to lie between boundries
 274  *              = FALSE can take any value it likes
 275  * int bb1:     lower bound
 276  * int bb2:     upper bound
 277 */
 278 int
 279 pol_integer (int *n, int typecode, int boundcode, int bb1, int bb2)
 280 {
 281         pol_tok (&token);
 282
 283         if (pol.trace == TRUE)
 284             printf ("checking if current token %s is an integer\n", token.tokstr);
 285
 286         if (token.type == TT_INT || token.type == TT_REAL) {
 287            if (boundcode == TRUE) {
 288                 if (token.inum < bb1)
 289                    *n = bb1;
 290                 else if (token.inum > bb2)
 291                    *n = bb2;
 292                 else
 293                     *n = token.inum;
 294             } else
 295                 *n = token.inum;
 296             dumptok (&token);
 297             return (TRUE);
 298         }
 299         *n = 0;
 300         return (FALSE);
 301 }
 302
 303 int
 304 pol_float (double *n, double typecode, double boundcode, double bb1, double bb2)
 305 {
 306         pol_tok (&token);
 307
 308         if (pol.trace == TRUE)
 309             printf ("checking if current token %s is an floating point number\n", token.tokstr);
 310
 311         if (token.type == TT_INT || token.type == TT_REAL) {
 312            if (boundcode == TRUE) {
 313                 if (token.fnum < bb1)
 314                    *n = bb1;
 315                 else if (token.fnum > bb2)
 316                    *n = bb2;
 317                 else
 318                     *n = token.fnum;
 319             } else
 320                 *n = token.fnum;
 321             dumptok (&token);
 322             return (TRUE);
 323         }
 324         *n = 0.0;
 325         return (FALSE);
 326 }
 327
 328 /*----------------------------------------------------------------------*/
 329 /* pol_skip() - skip over any token except for end of command sequence  */
 330 /*                                                                      */
 331 /*              returns TRUE if succesful skip                          */
 332 /*              returns FALSE if already at end of command or EOF       */
 333 /*----------------------------------------------------------------------*/
 334
 335 int pol_skip(void)
 336 {
 337         char term[5];           /* string of characters not to skip */
 338
 339         term[0] = meta.eoc;
 340         if (pol.nl_eoc == TRUE) {
 341             term[1] = NEWLINE;
 342             term[2] = EOS;
 343         } else
 344             term[1] = EOS;
 345
 346         return (skiptok (term));
 347 }
 348
 349 void pol_reader(void)
 350 {
 351         while (pol_skip() == TRUE)
 352             ;
 353
 354         dumptok (&token);               /* skip end of command token */
 355 }
 356
 357 /* skiptok (term) - skip a token unless the first character of a token is
 358  *                  in the string of terminators, term.
 359  * char *term - string of termination characters, don't skip these characters
 360  *              skiptok() also does NOT skip TT_EOF
 361  * returns (TRUE) if succesful skip of a token
 362  * returns (FALSE) if didn't skip, read termination character or TT_EOF
 363  */
 364
 365 static int
 366 skiptok (char term[])
 367 {
 368         pol_tok (&token);
 369
 370         if (token.type == TT_EOF
 371         || (token.type == TT_SPECLCHAR && strchr(term, token.tokstr[0]) != NULL))
 372                 return (FALSE);
 373         else {
 374             dumptok (&token);
 375             return (TRUE);
 376         }
 377 }
 378
 379 static int
 380 pol_tok (struct token_st *token)
 381 {
 382         if (token->ready == FALSE)
 383             getpol_tok(token);
 384         else
 385             if (token->type == TT_EOF && pol_lookchar() != EOF)
 386                 getpol_tok(token);
 387         return (token->type);
 388 }
 389
 390 static void
 391 dumptok (struct token_st *token)
 392 {
 393         if (token->ready == FALSE)
 394             getpol_tok(token);
 395         token->ready = FALSE;
 396 }
 397
 398 static int
 399 getpol_tok (struct token_st *token)
 400 {
 401         SYMBOL *sym;
 402
 403         token->ready = FALSE;
 404 nexttok:
 405         gettok (token);
 406
 407         if (token->type == TT_BLANK)
 408             goto nexttok;
 409         if (token->type == TT_SPECLCHAR) {
 410             if (strchr(pol.skipchars, token->tokstr[0]) != NULL)
 411                 goto nexttok;
 412             if (token->tokstr[0] == NEWLINE)
 413                 goto nexttok;
 414             if (token->tokstr[0] == meta.cmd) {
 415                 getcmd();
 416                 goto nexttok;
 417             }
 418             if (token->tokstr[0] == meta.com) {         /* skip comment */
 419                 eatline ();
 420                 goto nexttok;
 421             }
 422             if (token->tokstr[0] == meta.out) {
 423                 getescape(token->tokstr, meta.out, MAXTOK);
 424                 fputs (token->tokstr, stderr);
 425                 goto nexttok;
 426             }
 427             if (token->tokstr[0] == meta.con) {         /* continuation across NEWLINE */
 428                 while (pol_lookchar() == BLANK || pol_lookchar() == TAB)
 429                     pol_inchar();
 430                 if (pol_lookchar() == NEWLINE)
 431                     pol_inchar();
 432             }
 433             if (token->tokstr[0] == meta.ter) {         /* get input from terminal */
 434                 pol_usefile (P_USE_FILE, "");
 435                 pol_tok (token);
 436                 pol_closefile();
 437                 return (token->type);
 438             }
 439         }
 440
 441         /* look for filler words */
 442
 443         if (lookup (skiptable, token->tokstr) != NULL)  /* ignore words in skip table */
 444             goto nexttok;
 445
 446         /* look for user defined symbols */
 447
 448         if ((sym = lookup (usertable, token->tokstr)) != NULL) {
 449             token->type = TT_USERTOK;
 450             token->code = sym->code;
 451         } else
 452             token->code = 0;
 453
 454         if (pol.trace == TRUE)
 455             printf ("Read token '%s', type = %d\n", token->tokstr, token->type);
 456
 457         return (token->type);
 458 }
 459
 460
 461 static int getcmd(void)
 462 {
 463         int tt, found;
 464         char str[MAXTOK+1];
 465         SYMBOL *cmd;
 466         TOKEN tok;
 467
 468         tt = getalpha (str, MAXTOK);
 469         if (tt == TT_ERROR) {
 470             synerr ("error in pol parameter command");
 471             pol_reader();
 472             return(FALSE);
 473         }
 474         if ((cmd = lookup (cmdtable,str)) == NULL) {
 475             synerr ("unrecognized command");
 476             pol_reader();
 477             return (FALSE);
 478         } else {
 479             found = FALSE;
 480             switch (cmd->code) {
 481                 case PC_TRON:
 482                     pol.trace = TRUE;
 483                     found = TRUE;
 484                     break;
 485                 case PC_TROFF:
 486                     pol.trace = FALSE;
 487                     found = TRUE;
 488                     break;
 489                 case PC_FILE:
 490                     found = TRUE;
 491                     tt = gettok (&tok);
 492                     pol_usefile (P_USE_FILE, tok.tokstr);
 493                     break;
 494                 case PC_NL_EOC:
 495                     found = TRUE;
 496                     pol.nl_eoc = TRUE;
 497                     break;
 498                 case PC_NL_NEOC:
 499                     found = TRUE;
 500                     pol.nl_eoc = FALSE;
 501                     break;
 502                 case PC_DUMP:
 503                     found = TRUE;
 504                     printf("eoc = %c  str = %c  com = %c  cmd = %c  prg = %c\n",
 505                         meta.eoc, meta.str, meta.com, meta.cmd, meta.prg);
 506                     printf("con = %c  out = %c  ter = %c  inb = %c\n",
 507                         meta.con, meta.out, meta.ter, meta.inb);
 508                     break;
 509             }
 510             if (found == FALSE) {
 511                 tt = gettok (&tok);
 512                 if (tt != TT_SPECLCHAR) {
 513                     synerr("illegal command character");
 514                     return (FALSE);
 515                 }
 516                 switch(cmd->code) {
 517                     case PC_EOC:
 518                         meta.eoc = tok.tokstr[0];
 519                         break;
 520                     case PC_STR:
 521                         meta.str = tok.tokstr[0];
 522                         break;
 523                     case PC_COM:
 524                         meta.com = tok.tokstr[0];
 525                         break;
 526                     case PC_CMD:
 527                         meta.cmd = tok.tokstr[0];
 528                         break;
 529                     case PC_PRG:
 530                         meta.prg = tok.tokstr[0];
 531                         break;
 532                     case PC_CON:
 533                         meta.con = tok.tokstr[0];
 534                         break;
 535                     case PC_OUT:
 536                         meta.out = tok.tokstr[0];
 537                         break;
 538                     case PC_TER:
 539                         meta.ter = tok.tokstr[0];
 540                         break;
 541                     case PC_INB:
 542                         meta.inb = tok.tokstr[0];
 543                         break;
 544                     default:
 545                         printf("command not implemented\n");
 546                         break;
 547                 }                               /* switch (tok->type) */
 548             }                                   /* if (found == FALSE) */
 549             pol_reader();                       /* clean up command */
 550         }                                       /* if legal command */
 551
 552         return (TRUE);
 553 }
 554
 555
 556 static int
 557 gettok (TOKEN *tok)
 558 {
 559         int c, toktype;
 560         int inum;
 561         double fnum;
 562         int toksiz = MAXTOK;            /* maximum length of token string */
 563
 564         while ((c = pol_inchar()) == BLANK || c == TAB)
 565             ;
 566         pol_ungetch (c);
 567
 568         c = pol_lookchar();
 569         toktype = type(c);
 570
 571         fnum = 0.0;
 572         inum = 0;
 573
 574         if (c == BLANK || c == TAB) {                   /* skip white space */
 575             getblank(tok->tokstr, toksiz);
 576             toktype = TT_BLANK;
 577         } else if (toktype == LETTER) {
 578             toktype = getalpha (tok->tokstr, toksiz);
 579         } else if (c == meta.str) {                     /* quoted string */
 580             getquote (tok->tokstr, toksiz);
 581             toktype = TT_STRING;
 582         } else if (type(c) == DIGIT || c == PLUS || c == HYPHEN || c == PERIOD) {
 583             toktype = getnumber (tok->tokstr, toksiz, &fnum, &inum);
 584         } else if (c == EOF) {
 585             tok->tokstr[0] = EOS;
 586             toktype = TT_EOF;
 587         } else {
 588             c = pol_inchar();
 589             tok->tokstr[0] = c;
 590             tok->tokstr[1] = EOS;
 591             toktype = TT_SPECLCHAR;
 592         }
 593
 594         tok->type = toktype;
 595         tok->ready = TRUE;
 596         if (tok->type == TT_REAL || tok->type == TT_INT) {
 597             tok->fnum = fnum;
 598             tok->inum = inum;
 599         } else {
 600             tok->fnum = 0.0;
 601             tok->inum = 0;
 602         }
 603
 604         return (toktype);
 605 }
 606
 607
 608 static void
 609 getblank (char *s, int toksiz)
 610 {
 611         int c;
 612
 613         while ((c = pol_inchar()) == BLANK || c == TAB)
 614               ;
 615         pol_ungetch(c);
 616
 617         s[0] = BLANK;
 618         s[1] = EOS;
 619 }
 620
 621
 622 static int
 623 getalpha (char *s, int toksiz)
 624 {
 625         int i, chartype, alphatype;
 626
 627         if (type(pol_lookchar()) != LETTER) {
 628             s[0] = EOS;
 629             return (TT_ERROR);
 630         }
 631
 632         alphatype = TT_ALPHA;
 633         for (i = 0; i < toksiz; i++) {          /* get alphanumeric token */
 634             s[i] = pol_inchar();
 635             chartype = type (s[i]);
 636             if (chartype != LETTER && chartype != DIGIT)
 637                 break;
 638             if (chartype == DIGIT)
 639                 alphatype = TT_ALPNUM;
 640         }
 641         pol_ungetch(s[i]);
 642
 643         if (i >= toksiz)
 644             synerr("token too long.");
 645
 646         s[i] = EOS;                     /* terminate token */
 647         return (alphatype);
 648 }
 649
 650
 651 /* getquote - get quoted string from file */
 652 /* have already gotten delimiter in qs[0] */
 653 static void
 654 getquote (char *qs, int toksiz)
 655 {
 656         int delim;
 657
 658         delim = pol_inchar();                   /* char = delimiter */
 659         getescape(qs, delim, toksiz);
 660 }
 661
 662
 663 static void
 664 getescape (     /* reads up to delim */
 665     char *s,
 666     int delim,
 667     int toksiz
 668 )
 669 {
 670         int i, c;
 671
 672         for (i = 0; (c = pol_inchar()) != delim; i++) {
 673             if (c == NEWLINE) {
 674                 synerr ("Missing closing delimiter.");
 675                 break;
 676             }
 677             if (i >= toksiz) {
 678                 synerr("string too long.");
 679                 break;
 680             }
 681             if (c == EOF) {
 682                 pol_ungetch(c);
 683                 synerr("end of file inside quotation");
 684                 break;
 685             } else if (c == BSLASH) {   /* escape character */
 686                 s[i++] = c;
 687                 c = pol_inchar();               /* get escaped character */
 688             }
 689             s[i] = c;
 690         }
 691         s[i] = EOS;
 692 }
 693
 694 void
 695 gettext (char *str, int lim)
 696 {
 697         int c, i;
 698
 699         while ((c = pol_inchar()) == BLANK || c == TAB)
 700             ;
 701         pol_ungetch (c);
 702
 703         for (i = 0; i < lim && (c = pol_inchar()) != EOF && c != NEWLINE; i++)
 704             str[i] = c;
 705         pol_ungetch (c);
 706         str[i] = EOS;
 707 }
 708
 709 /*----------------------------------------------*/
 710 /* Get a number for gettok()                    */
 711 /*----------------------------------------------*/
 712
 713 static int
 714 getnumber (
 715     char str[],                         /* string to return token in */
 716     int strsize,                                /* maximum length of token string */
 717     double *fnum,                               /* floating point value of number read */
 718     int *inum                           /* integer value of number read */
 719 )
 720 {
 721         int c, sp, isSigned;
 722         double sign, whole, frac, powerof10, exp, expsign;
 723
 724         sp = 0;
 725         sign = 1.0;
 726         isSigned = FALSE;               /* TRUE if number prefixed by '+' or '-' */
 727         *fnum = 0.0;
 728         *inum = 0;
 729         str[0] = EOS;
 730
 731         c = pol_inchar();
 732         if (c == HYPHEN) {
 733             str[sp++] = c;
 734             isSigned = TRUE;
 735             sign = -1.0;
 736         } else if (c == PLUS) {
 737             str[sp++] = c;
 738             isSigned = TRUE;
 739             sign = 1.0;
 740         } else if (c == PERIOD) {
 741             if (type(pol_lookchar()) != DIGIT) {
 742                 str[0] = PERIOD;
 743                 str[1] = EOS;
 744                 return (TT_SPECLCHAR);
 745             } else
 746                 pol_ungetch (PERIOD);
 747         } else if (type(c) != DIGIT) {
 748             pol_ungetch (c);
 749             return (TT_ERROR);
 750         } else
 751             pol_ungetch (c);
 752
 753         if (isSigned == TRUE) {
 754             c = pol_lookchar();
 755             if (c == PERIOD) {
 756                 pol_inchar();           /* get period */
 757                 c = pol_lookchar();             /* look at character past period */
 758                 pol_ungetch (PERIOD);   /* put back period */
 759                 if (type(c) != DIGIT) {
 760                     str[sp] = EOS;
 761                     return (TT_SPECLCHAR);
 762                 }
 763             } else if (type (c) != DIGIT) {
 764                 str[sp] = EOS;
 765                 return (TT_SPECLCHAR);
 766             }
 767         }
 768
 769         whole = 0.0;
 770         while (type(c = pol_inchar()) == DIGIT) {
 771             if (sp < strsize)
 772                 str[sp++] = c;
 773             whole = 10.0 * whole + (c - '0');
 774         }
 775         pol_ungetch (c);                /* put back non-numeric character */
 776
 777         if (c != PERIOD && tolower(c) != 'e') {
 778             str[sp] = EOS;
 779             *fnum = whole * sign;
 780             if (*fnum < MIN_INT)
 781                 *inum = MIN_INT;
 782             else if (*fnum > MAX_INT)
 783                 *inum = MAX_INT;
 784             else
 785                 *inum = (int) *fnum;
 786             return (TT_INT);
 787         }
 788
 789         if (pol_lookchar() == PERIOD) {
 790             pol_inchar();
 791             if (sp < strsize)
 792                 str[sp++] = PERIOD;
 793         }
 794
 795         frac = 0.0;
 796         powerof10 = 10.0;
 797
 798         while (type(c = pol_inchar()) == DIGIT) {
 799             if (sp < strsize)
 800                 str[sp++] = c;
 801             frac += (double) (c - '0') / powerof10;
 802             powerof10 *= 10.0;
 803         }
 804         pol_ungetch (c);
 805
 806         exp = 0.0;
 807         expsign = 1.0;
 808         c = pol_inchar();
 809         if (tolower(c) != 'e')
 810             pol_ungetch (c);
 811         else {
 812             if (sp < strsize)
 813                 str[sp++] = c;
 814             if ((c = pol_inchar()) == PLUS) {
 815                 if (sp < strsize)
 816                     str[sp++] = c;
 817                 expsign = 1.0;
 818             } else if (c == HYPHEN) {
 819                 if (sp < strsize)
 820                     str[sp++] = c;
 821                 expsign = -1.0;
 822             } else if (type(c) != DIGIT) {
 823                 --sp;                           /* erase 'e' */
 824                 pol_ungetch (c);
 825                 pol_ungetch ('e');
 826                 goto getnumexit;
 827             } else
 828                 pol_ungetch(c);
 829
 830             exp = 0;
 831             while (type(c = pol_inchar()) == DIGIT) {
 832                 if (sp < strsize)
 833                     str[sp++] = c;
 834                 exp = 10 * exp + (c - '0');
 835             }
 836             pol_ungetch (c);
 837         }
 838
 839 getnumexit:
 840         str[sp] = EOS;
 841         *fnum = sign * (whole + frac) * pow (10.0, expsign * exp);
 842         if (*fnum < MIN_INT)
 843             *inum = MIN_INT;
 844         else if (*fnum > MAX_INT)
 845             *inum = MAX_INT;
 846         else
 847             *inum = (int) *fnum;
 848         return (TT_REAL);
 849 }
 850
 851 static void
 852 eatline (void)
 853 {
 854         char term [2];
 855
 856         term[0] = NEWLINE;
 857         term[1] = EOS;
 858         skiptok (term);
 859 }
 860
 861 static int
 862 type (          /* return type of ASCII character */
 863     int c
 864 )
 865 {
 866         if (isalpha(c) || c == UNDERLIN)
 867             return (LETTER);
 868         else if (isdigit(c))
 869             return (DIGIT);
 870         else
 871             return (c);
 872 }
 873
 874 /*----------------------------------------------------------------------*/
 875 /*                                                                      */
 876 /*  hash table routines. Kernighan & Ritchie                            */
 877 /*                                                                      */
 878 /*----------------------------------------------------------------------*/
 879
 880 /* inittable (table)
 881  *      clear symbol table
 882 */
 883
 884 static void
 885 inittable (SYMBOL *table[])
 886 {
 887         int i;
 888
 889         for (i = 0; i < HASHSIZE; i++)
 890             table[i] = NULL;
 891 }
 892
 893 /* freetable (table)
 894  *      free all memory allocated to table, then clear table
 895  */
 896
 897 static void
 898 freetable (SYMBOL *table[])
 899 {
 900         int i;
 901         SYMBOL *p, *np;
 902
 903         for (i = 0; i < HASHSIZE; i++) {
 904             np = table[i];
 905             while (np != NULL) {
 906                 p = np->next;
 907                 free (np);
 908                 np = p;
 909             }
 910         }
 911         inittable (table);
 912 }
 913
 914 static int
 915 hash (          /* form hash value of string s */
 916     char *s
 917 )
 918 {
 919         int hashval;
 920
 921         for (hashval = 0; *s != EOS; )
 922             hashval += *s++;
 923         return (hashval % HASHSIZE);
 924 }
 925
 926 /* Look for s in hash table */
 927 static SYMBOL *
 928 lookup ( SYMBOL *table[], char *s )
 929 {
 930     SYMBOL *np;
 931     SYMBOL *found = NULL;
 932
 933     for (np = table[hash(s)]; np != NULL; np = np->next)
 934         if (strcasecmp(s, np->name) == 0) {
 935             found = np;         /* found it */
 936             break;
 937         }
 938
 939     return (found);
 940 }
 941
 942 static SYMBOL *
 943 install (SYMBOL *table[], char *name, int def)
 944 {
 945     static char installerr[] = "install: out of memory";
 946     SYMBOL *np;
 947     int hashval;
 948
 949     if ((np = lookup (table, name)) == NULL) {  /* not found */
 950         np = (SYMBOL *) malloc (sizeof(*np));
 951         if (np == NULL) {
 952             synerr(installerr);
 953             return (NULL);
 954         }
 955         if ((np->name = strdup(name)) == NULL) {
 956             synerr(installerr);
 957             return (NULL);
 958         }
 959         str_lower (np->name);
 960         np->code = def;
 961         hashval = hash(np->name);
 962         np->next = table[hashval];
 963         table[hashval] = np;
 964     } else                                      /* already there */
 965         np->code = def;
 966     return (np);
 967 }
 968
 969 /*----------------------------------------------------------------------*/
 970 /*                              POL OUTPUT                              */
 971 /*----------------------------------------------------------------------*/
 972
 973 #define MAXFILE 8
 974
 975 static int currentf = -1;               /* pointer to current fp */
 976 static FILE *filep[MAXFILE];            /* == NULL for string input */
 977 static char *fname[MAXFILE];            /* pointer to filename */
 978
 979 static char inputline[MAXLINE];         /* current input line */
 980 static int lineptr;                     /* current position in inputline */
 981
 982 static void
 983 synerr (char *msg)
 984 {
 985         fputs (fname[currentf], stderr);
 986         fputs (msg, stderr);
 987         fputc (NEWLINE, stderr);
 988 }
 989
 990 /*----------------------------------------------------------------------*/
 991 /*                              POL INPUT                               */
 992 /*----------------------------------------------------------------------*/
 993
 994 #define BUFSIZE 100
 995 static int bp = 0;              /* pointer to next free position */
 996 static int buf[BUFSIZE];        /* pushed back input characters */
 997
 998 /* pol_usefile - set source of POL input
 999  *
1000  *    int source - source of input
1001  *                 P_USE_STR  - have POL use strings as input
1002  *                 P_USE_FILE - use file.  filename is in str
1003  *
1004 */
1005
1006 void
1007 pol_usefile (int source, char *fn)
1008 {
1009         FILE *fp;
1010
1011         ++currentf;
1012         if (currentf >= MAXFILE) {
1013             --currentf;
1014             synerr ("files nested too deeply");
1015             return;
1016         }
1017
1018         bp = 0;                         /* clear any pushed back input */
1019
1020         if (source == P_USE_STR) {
1021             filep[currentf] = NULL;
1022         } else if (source == P_USE_FILE) {
1023             if (fn == NULL || strlen(fn) == 0) {
1024                 fp = stdin;
1025             } else if ((fp = fopen(fn, "r")) == NULL) {
1026                 --currentf;
1027                 synerr ("can't open file");
1028                 return;
1029             }
1030             filep[currentf] = fp;
1031             fname[currentf] = strdup (fn);
1032         }
1033 }
1034
1035 void pol_closefile(void)
1036 {
1037         if (currentf >= 0) {
1038             if (filep[currentf] != NULL)
1039                 fclose (filep[currentf]);
1040             --currentf;
1041         }
1042 }
1043
1044 /*-----------------------------*/
1045 /* Lowest Level Input Routines */
1046 /*-----------------------------*/
1047
1048
1049 int pol_lookchar(void)
1050 {
1051         int c;
1052
1053         c = pol_inchar();
1054         pol_ungetch (c);
1055         return (c);
1056 }
1057
1058 int pol_inchar(void)
1059 {
1060   int c = 0;
1061
1062   if (currentf < 0)
1063     return (EOF);
1064
1065   while (currentf >= 0 && (c = pol_getch(filep[currentf])) == EOF && filep[currentf] != NULL) {
1066     pol_closefile ();
1067   }
1068
1069   return (c);
1070 }
1071
1072 /*--------------------------------------------------------------*/
1073 /* getch - get a (possibly pushed back) character               */
1074 /*         if fp == NULL, then get character from inputline     */
1075 /*--------------------------------------------------------------*/
1076
1077 static int
1078 pol_getch (FILE *fp)
1079 {
1080         int c;
1081
1082         if (bp > 0)
1083             return (buf[--bp]);
1084
1085         if (fp == NULL) {
1086             if ((c = inputline[lineptr]) == EOS)
1087                 return (EOF);
1088             else {
1089                 ++lineptr;
1090                 return (c);
1091             }
1092         } else
1093             c = fgetc(fp);
1094
1095         return (c);
1096 }
1097
1098 /* push character back on input */
1099 void
1100 pol_ungetch (int c)
1101 {
1102         if (bp > BUFSIZE)
1103             sys_error (ERR_SEVERE, "too many characters pushed back [pol_ungetch]");
1104         else
1105             buf[bp++] = c;
1106 }
1107
1108
1109 int
1110 get_inputline (FILE *fp)
1111 {
1112         lineptr = 0;
1113         bp = 0;
1114         if (fgets (inputline, MAXLINE, fp) == NULL)
1115             return (EOF);
1116         else
1117             return (OK);
1118 }
1119
1120 void
1121 set_inputline (char *line)
1122 {
1123         lineptr = 0;
1124         bp = 0;
1125         strncpy (inputline, line, MAXLINE);
1126 }