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