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