libctgraphics/pol.cpp

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