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