libctgraphics/ezpol.cpp

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