Fix BUGS -- see BUGS file
+Convert pol to C++ object.
noinst_LIBRARIES = libctgraphics.a
-libctgraphics_a_SOURCES=ezplot.cpp ezset.cpp ezpol.cpp sgp.cpp transformmatrix.cpp
+libctgraphics_a_SOURCES=ezplot.cpp ezset.cpp pol.cpp sgp.cpp transformmatrix.cpp
INCLUDES=@my_includes@
EXTRA_DIST=Makefile.nt
+++ /dev/null
-/*****************************************************************************
-** FILE IDENTIFICATION
-**
-** POL - Problem Oriented Language
-**
-** This is part of the CTSim program
-** Copyright (C) 1983-2000 Kevin Rosenberg
-**
-** $Id: ezpol.cpp,v 1.3 2000/07/13 07:03:21 kevin Exp $
-**
-** This program is free software; you can redistribute it and/or modify
-** it under the terms of the GNU General Public License (version 2) as
-** published by the Free Software Foundation.
-**
-** This program is distributed in the hope that it will be useful,
-** but WITHOUT ANY WARRANTY; without even the implied warranty of
-** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-** GNU General Public License for more details.
-**
-** You should have received a copy of the GNU General Public License
-** along with this program; if not, write to the Free Software
-** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-******************************************************************************/
-/* */
-/*----------------------------------------------------------------------*/
-
-#include <math.h>
-#include <stdio.h>
-#include <ctype.h>
-#include "ctsupport.h"
-#include "pol.h"
-
-
-static const int HASHSIZE=20;
-
-
-/* Tables words stored with install() & found with lookup() */
-static SYMBOL *skiptable[HASHSIZE]; /* words to ignore and skip */
-static SYMBOL *cmdtable[HASHSIZE]; /* pol parameter commands */
-static SYMBOL *usertable[HASHSIZE]; /* user defined symbols */
-
-static struct token_st token; /* current token */
-
-static struct metachar {
- char eoc; /* end of command character */
- char str; /* string delimiter */
- char com; /* comment character */
- char cmd; /* pol parameter command character */
- char prg; /* program load character */
- char con; /* continuation across newline character */
- char out; /* character that delimits output to terminal */
- char ter; /* character indicates insertion of input from terminal */
- char inb; /* input from graphics device */
-} meta;
-
-/* current pol state */
-
-static struct pol_st {
- char skipchars[MAXSKIPCHAR]; /* characters to skip */
- int nl_eoc; /* TRUE if newline character ends a command */
- int trace; /* TRUE if trace is on */
-} pol;
-
-struct key {
- char *keyword;
- int code;
-};
-
-/* internal codes for pol commands */
-
-#define PC_EOC 1
-#define PC_STR 2
-#define PC_COM 3
-#define PC_CMD 4
-#define PC_PRG 5
-#define PC_CON 6
-#define PC_OUT 7
-#define PC_TER 8
-#define PC_INB 9
-#define PC_NL_EOC 10
-#define PC_NL_NEOC 11
-#define PC_TRON 12
-#define PC_TROFF 13
-#define PC_FILE 14
-#define PC_DUMP 15
-
-static struct key cmdlist[] = {
- { "eoc", PC_EOC,},
- { "str", PC_STR,},
- { "com", PC_COM,},
- { "cmd", PC_CMD,},
- { "prg", PC_PRG,},
- { "con", PC_CON,},
- { "out", PC_OUT,},
- { "ter", PC_TER,},
- { "inb", PC_INB,},
-
- { "nl_eoc",PC_NL_EOC,},
- { "nl_neoc", PC_NL_NEOC,},
- { "tron", PC_TRON,},
- { "troff", PC_TROFF,},
- { "file", PC_FILE,},
- { "dump", PC_DUMP,},
-};
-
-#define NUMCMD (sizeof(cmdlist) / sizeof (struct key))
-
-static int skiptok(char term[]);
-static int pol_tok(struct token_st *token);
-static void dumptok(struct token_st *token);
-
-
-static int getpol_tok(struct token_st *token);
-static int getcmd(void);
-static int gettok (TOKEN *tok);
-static void getblank(char *s, int toksiz);
-static int getalpha(char *s, int toksiz);
-static void getquote(char *qs, int toksiz);
-static void getescape(char *s, int delim, int toksiz);
-static int getnumber (char str[], int strsize, double *fnum, int *inum);
-static void eatline(void);
-static int type(int c);
-static void inittable(SYMBOL *table[]);
-static void freetable(SYMBOL *table[]);
-static int hash(char *s);
-static SYMBOL *lookup(SYMBOL *table[], char *s);
-static SYMBOL *install(SYMBOL *table[], char *s, int def);
-static void outch(int c);
-static void inc_line(void);
-static int getlinect(void);
-static void setlinect(int n);
-static void synerr(char *msg);
-static int pol_getch(FILE *fp);
-static void ungets(char *s);
-
-
-void pol_init (void)
-{
- meta.eoc = SEMICOL;
- meta.str = DQUOTE;
- meta.com = SHARP;
- meta.cmd = EXCLAM;
- meta.prg = ATSIGN;
- meta.con = AMPERSAND;
- meta.out = DOLLAR;
- meta.ter = PERCENT;
- meta.inb = LBRACK;
-
- pol.nl_eoc = TRUE;
- pol.skipchars[0] = EOS;
-
- inittable (cmdtable); /* initialize symbol tables */
- inittable (usertable);
- inittable (skiptable);
-
- for (unsigned int i = 0; i < NUMCMD; i++)
- install (cmdtable, cmdlist[i].keyword, cmdlist[i].code);
-
- token.ready = FALSE; /* no token read yet */
-}
-
-/* pol_skpword (w)
- *
- * char *w - word for pol to ignore and skip over in input
- *
- * pol_tok() compares all tokens to words given to this routine. If it finds it,
- * it will immediately read another token.
- */
-
-void
-pol_skpword (char *w)
-{
- if (install (skiptable, w, 0) == NULL)
- synerr ("Too many skip words defined");
-}
-
-/* pol_skpchar (s)
- *
- * skip all characters that appear in string s
- */
-void
-pol_skpchar (char *s)
-{
- strncpy (pol.skipchars, s, MAXSKIPCHAR);
-}
-
-/* pol_install (str, code)
- *
- * char *str - token string to install
- * int code - code to return for token
- *
- * pol_tok() looks for these user defined tokens. If it finds one,
- * it stores the tokens code in the token structure and returns TT_USERTOK
- */
-int
-pol_install (char *str, int code)
-{
- if (install (usertable, str, code) == NULL)
- {
- synerr ("Out ot memory installing user tokens");
- return (FALSE);
- }
-
- return(TRUE);
-}
-
-/* get_word - matches tokens on a letter by letter basis
- *
- * char *search - string to search for
- * int nlet - maximum number of chars to search for match
- */
-
-int
-pol_word (char *search, int nlet)
-{
- pol_tok (&token);
- if (pol.trace == TRUE)
- printf ("matching current token %s against word %s\n", token.tokstr, search);
-
- if (strncasecmp (search, token.tokstr, nlet) == 0) {
- dumptok (&token);
- return (TRUE);
- } else
- return (FALSE);
-}
-
-/* pol_usertok (str,code)
- * see if current token is a user defined token set with pol_install()
- *
- * char *str - token string as read from input
- * int *code - returned code for user defined symbol
- * return value - TRUE if current token has been user defined
- * FALSE if current token is not user defined
- */
-int
-pol_usertok (char *str, int *code)
-{
- pol_tok (&token);
-
- if (pol.trace == TRUE)
- printf ("checking if current token '%s' is user defined\n", token.tokstr);
-
- if (token.type == TT_USERTOK) {
- *code = token.code;
- strcpy (str, token.tokstr);
- dumptok (&token);
- return (TRUE);
- } else {
- *code = 0;
- return (FALSE);
- }
-}
-
-/* isstring (s) - returns TRUE if current token is a string
- *
- * char *s - pointer to place to store token string
-*/
-
-int
-pol_string (char *str)
-{
- pol_tok (&token);
-
- if (token.type == TT_STRING) {
- strcpy (str, token.tokstr);
- dumptok (&token);
- return (TRUE);
- } else
- return (FALSE);
-}
-
-/* pol_integer - test for an integer
- *
- * int *n: returned integer value
- * int typecode = TT_INT if accept only integer values
- * = TT_REAL if accept both real and integer values
- * int boundcode= TRUE if force to lie between boundries
- * = FALSE can take any value it likes
- * int bb1: lower bound
- * int bb2: upper bound
-*/
-int
-pol_integer (int *n, int typecode, int boundcode, int bb1, int bb2)
-{
- pol_tok (&token);
-
- if (pol.trace == TRUE)
- printf ("checking if current token %s is an integer\n", token.tokstr);
-
- if (token.type == TT_INT || token.type == TT_REAL) {
- if (boundcode == TRUE) {
- if (token.inum < bb1)
- *n = bb1;
- else if (token.inum > bb2)
- *n = bb2;
- else
- *n = token.inum;
- } else
- *n = token.inum;
- dumptok (&token);
- return (TRUE);
- }
- *n = 0;
- return (FALSE);
-}
-
-int
-pol_float (double *n, double typecode, double boundcode, double bb1, double bb2)
-{
- pol_tok (&token);
-
- if (pol.trace == TRUE)
- printf ("checking if current token %s is an floating point number\n", token.tokstr);
-
- if (token.type == TT_INT || token.type == TT_REAL) {
- if (boundcode == TRUE) {
- if (token.fnum < bb1)
- *n = bb1;
- else if (token.fnum > bb2)
- *n = bb2;
- else
- *n = token.fnum;
- } else
- *n = token.fnum;
- dumptok (&token);
- return (TRUE);
- }
- *n = 0.0;
- return (FALSE);
-}
-
-/*----------------------------------------------------------------------*/
-/* pol_skip() - skip over any token except for end of command sequence */
-/* */
-/* returns TRUE if succesful skip */
-/* returns FALSE if already at end of command or EOF */
-/*----------------------------------------------------------------------*/
-
-int pol_skip(void)
-{
- char term[5]; /* string of characters not to skip */
-
- term[0] = meta.eoc;
- if (pol.nl_eoc == TRUE) {
- term[1] = NEWLINE;
- term[2] = EOS;
- } else
- term[1] = EOS;
-
- return (skiptok (term));
-}
-
-void pol_reader(void)
-{
- while (pol_skip() == TRUE)
- ;
-
- dumptok (&token); /* skip end of command token */
-}
-
-/* skiptok (term) - skip a token unless the first character of a token is
- * in the string of terminators, term.
- * char *term - string of termination characters, don't skip these characters
- * skiptok() also does NOT skip TT_EOF
- * returns (TRUE) if succesful skip of a token
- * returns (FALSE) if didn't skip, read termination character or TT_EOF
- */
-
-static int
-skiptok (char term[])
-{
- pol_tok (&token);
-
- if (token.type == TT_EOF
- || (token.type == TT_SPECLCHAR && strchr(term, token.tokstr[0]) != NULL))
- return (FALSE);
- else {
- dumptok (&token);
- return (TRUE);
- }
-}
-
-static int
-pol_tok (struct token_st *token)
-{
- if (token->ready == FALSE)
- getpol_tok(token);
- else
- if (token->type == TT_EOF && pol_lookchar() != EOF)
- getpol_tok(token);
- return (token->type);
-}
-
-static void
-dumptok (struct token_st *token)
-{
- if (token->ready == FALSE)
- getpol_tok(token);
- token->ready = FALSE;
-}
-
-static int
-getpol_tok (struct token_st *token)
-{
- SYMBOL *sym;
-
- token->ready = FALSE;
-nexttok:
- gettok (token);
-
- if (token->type == TT_BLANK)
- goto nexttok;
- if (token->type == TT_SPECLCHAR) {
- if (strchr(pol.skipchars, token->tokstr[0]) != NULL)
- goto nexttok;
- if (token->tokstr[0] == NEWLINE)
- goto nexttok;
- if (token->tokstr[0] == meta.cmd) {
- getcmd();
- goto nexttok;
- }
- if (token->tokstr[0] == meta.com) { /* skip comment */
- eatline ();
- goto nexttok;
- }
- if (token->tokstr[0] == meta.out) {
- getescape(token->tokstr, meta.out, MAXTOK);
- fputs (token->tokstr, stderr);
- goto nexttok;
- }
- if (token->tokstr[0] == meta.con) { /* continuation across NEWLINE */
- while (pol_lookchar() == BLANK || pol_lookchar() == TAB)
- pol_inchar();
- if (pol_lookchar() == NEWLINE)
- pol_inchar();
- }
- if (token->tokstr[0] == meta.ter) { /* get input from terminal */
- pol_usefile (P_USE_FILE, "");
- pol_tok (token);
- pol_closefile();
- return (token->type);
- }
- }
-
- /* look for filler words */
-
- if (lookup (skiptable, token->tokstr) != NULL) /* ignore words in skip table */
- goto nexttok;
-
- /* look for user defined symbols */
-
- if ((sym = lookup (usertable, token->tokstr)) != NULL) {
- token->type = TT_USERTOK;
- token->code = sym->code;
- } else
- token->code = 0;
-
- if (pol.trace == TRUE)
- printf ("Read token '%s', type = %d\n", token->tokstr, token->type);
-
- return (token->type);
-}
-
-
-static int getcmd(void)
-{
- int tt, found;
- char str[MAXTOK+1];
- SYMBOL *cmd;
- TOKEN tok;
-
- tt = getalpha (str, MAXTOK);
- if (tt == TT_ERROR) {
- synerr ("error in pol parameter command");
- pol_reader();
- return(FALSE);
- }
- if ((cmd = lookup (cmdtable,str)) == NULL) {
- synerr ("unrecognized command");
- pol_reader();
- return (FALSE);
- } else {
- found = FALSE;
- switch (cmd->code) {
- case PC_TRON:
- pol.trace = TRUE;
- found = TRUE;
- break;
- case PC_TROFF:
- pol.trace = FALSE;
- found = TRUE;
- break;
- case PC_FILE:
- found = TRUE;
- tt = gettok (&tok);
- pol_usefile (P_USE_FILE, tok.tokstr);
- break;
- case PC_NL_EOC:
- found = TRUE;
- pol.nl_eoc = TRUE;
- break;
- case PC_NL_NEOC:
- found = TRUE;
- pol.nl_eoc = FALSE;
- break;
- case PC_DUMP:
- found = TRUE;
- printf("eoc = %c str = %c com = %c cmd = %c prg = %c\n",
- meta.eoc, meta.str, meta.com, meta.cmd, meta.prg);
- printf("con = %c out = %c ter = %c inb = %c\n",
- meta.con, meta.out, meta.ter, meta.inb);
- break;
- }
- if (found == FALSE) {
- tt = gettok (&tok);
- if (tt != TT_SPECLCHAR) {
- synerr("illegal command character");
- return (FALSE);
- }
- switch(cmd->code) {
- case PC_EOC:
- meta.eoc = tok.tokstr[0];
- break;
- case PC_STR:
- meta.str = tok.tokstr[0];
- break;
- case PC_COM:
- meta.com = tok.tokstr[0];
- break;
- case PC_CMD:
- meta.cmd = tok.tokstr[0];
- break;
- case PC_PRG:
- meta.prg = tok.tokstr[0];
- break;
- case PC_CON:
- meta.con = tok.tokstr[0];
- break;
- case PC_OUT:
- meta.out = tok.tokstr[0];
- break;
- case PC_TER:
- meta.ter = tok.tokstr[0];
- break;
- case PC_INB:
- meta.inb = tok.tokstr[0];
- break;
- default:
- printf("command not implemented\n");
- break;
- } /* switch (tok->type) */
- } /* if (found == FALSE) */
- pol_reader(); /* clean up command */
- } /* if legal command */
-
- return (TRUE);
-}
-
-
-static int
-gettok (TOKEN *tok)
-{
- int c, toktype;
- int inum;
- double fnum;
- int toksiz = MAXTOK; /* maximum length of token string */
-
- while ((c = pol_inchar()) == BLANK || c == TAB)
- ;
- pol_ungetch (c);
-
- c = pol_lookchar();
- toktype = type(c);
-
- fnum = 0.0;
- inum = 0;
-
- if (c == BLANK || c == TAB) { /* skip white space */
- getblank(tok->tokstr, toksiz);
- toktype = TT_BLANK;
- } else if (toktype == LETTER) {
- toktype = getalpha (tok->tokstr, toksiz);
- } else if (c == meta.str) { /* quoted string */
- getquote (tok->tokstr, toksiz);
- toktype = TT_STRING;
- } else if (type(c) == DIGIT || c == PLUS || c == HYPHEN || c == PERIOD) {
- toktype = getnumber (tok->tokstr, toksiz, &fnum, &inum);
- } else if (c == EOF) {
- tok->tokstr[0] = EOS;
- toktype = TT_EOF;
- } else {
- c = pol_inchar();
- tok->tokstr[0] = c;
- tok->tokstr[1] = EOS;
- toktype = TT_SPECLCHAR;
- }
-
- tok->type = toktype;
- tok->ready = TRUE;
- if (tok->type == TT_REAL || tok->type == TT_INT) {
- tok->fnum = fnum;
- tok->inum = inum;
- } else {
- tok->fnum = 0.0;
- tok->inum = 0;
- }
-
- return (toktype);
-}
-
-
-static void
-getblank (char *s, int toksiz)
-{
- int c;
-
- while ((c = pol_inchar()) == BLANK || c == TAB)
- ;
- pol_ungetch(c);
-
- s[0] = BLANK;
- s[1] = EOS;
-}
-
-
-static int
-getalpha (char *s, int toksiz)
-{
- int i, chartype, alphatype;
-
- if (type(pol_lookchar()) != LETTER) {
- s[0] = EOS;
- return (TT_ERROR);
- }
-
- alphatype = TT_ALPHA;
- for (i = 0; i < toksiz; i++) { /* get alphanumeric token */
- s[i] = pol_inchar();
- chartype = type (s[i]);
- if (chartype != LETTER && chartype != DIGIT)
- break;
- if (chartype == DIGIT)
- alphatype = TT_ALPNUM;
- }
- pol_ungetch(s[i]);
-
- if (i >= toksiz)
- synerr("token too long.");
-
- s[i] = EOS; /* terminate token */
- return (alphatype);
-}
-
-
-/* getquote - get quoted string from file */
-/* have already gotten delimiter in qs[0] */
-static void
-getquote (char *qs, int toksiz)
-{
- int delim;
-
- delim = pol_inchar(); /* char = delimiter */
- getescape(qs, delim, toksiz);
-}
-
-
-static void
-getescape ( /* reads up to delim */
- char *s,
- int delim,
- int toksiz
-)
-{
- int i, c;
-
- for (i = 0; (c = pol_inchar()) != delim; i++) {
- if (c == NEWLINE) {
- synerr ("Missing closing delimiter.");
- break;
- }
- if (i >= toksiz) {
- synerr("string too long.");
- break;
- }
- if (c == EOF) {
- pol_ungetch(c);
- synerr("end of file inside quotation");
- break;
- } else if (c == BSLASH) { /* escape character */
- s[i++] = c;
- c = pol_inchar(); /* get escaped character */
- }
- s[i] = c;
- }
- s[i] = EOS;
-}
-
-void
-gettext (char *str, int lim)
-{
- int c, i;
-
- while ((c = pol_inchar()) == BLANK || c == TAB)
- ;
- pol_ungetch (c);
-
- for (i = 0; i < lim && (c = pol_inchar()) != EOF && c != NEWLINE; i++)
- str[i] = c;
- pol_ungetch (c);
- str[i] = EOS;
-}
-
-/*----------------------------------------------*/
-/* Get a number for gettok() */
-/*----------------------------------------------*/
-
-static int
-getnumber (
- char str[], /* string to return token in */
- int strsize, /* maximum length of token string */
- double *fnum, /* floating point value of number read */
- int *inum /* integer value of number read */
-)
-{
- int c, sp, isSigned;
- double sign, whole, frac, powerof10, exp, expsign;
-
- sp = 0;
- sign = 1.0;
- isSigned = FALSE; /* TRUE if number prefixed by '+' or '-' */
- *fnum = 0.0;
- *inum = 0;
- str[0] = EOS;
-
- c = pol_inchar();
- if (c == HYPHEN) {
- str[sp++] = c;
- isSigned = TRUE;
- sign = -1.0;
- } else if (c == PLUS) {
- str[sp++] = c;
- isSigned = TRUE;
- sign = 1.0;
- } else if (c == PERIOD) {
- if (type(pol_lookchar()) != DIGIT) {
- str[0] = PERIOD;
- str[1] = EOS;
- return (TT_SPECLCHAR);
- } else
- pol_ungetch (PERIOD);
- } else if (type(c) != DIGIT) {
- pol_ungetch (c);
- return (TT_ERROR);
- } else
- pol_ungetch (c);
-
- if (isSigned == TRUE) {
- c = pol_lookchar();
- if (c == PERIOD) {
- pol_inchar(); /* get period */
- c = pol_lookchar(); /* look at character past period */
- pol_ungetch (PERIOD); /* put back period */
- if (type(c) != DIGIT) {
- str[sp] = EOS;
- return (TT_SPECLCHAR);
- }
- } else if (type (c) != DIGIT) {
- str[sp] = EOS;
- return (TT_SPECLCHAR);
- }
- }
-
- whole = 0.0;
- while (type(c = pol_inchar()) == DIGIT) {
- if (sp < strsize)
- str[sp++] = c;
- whole = 10.0 * whole + (c - '0');
- }
- pol_ungetch (c); /* put back non-numeric character */
-
- if (c != PERIOD && tolower(c) != 'e') {
- str[sp] = EOS;
- *fnum = whole * sign;
- if (*fnum < MIN_INT)
- *inum = MIN_INT;
- else if (*fnum > MAX_INT)
- *inum = MAX_INT;
- else
- *inum = (int) *fnum;
- return (TT_INT);
- }
-
- if (pol_lookchar() == PERIOD) {
- pol_inchar();
- if (sp < strsize)
- str[sp++] = PERIOD;
- }
-
- frac = 0.0;
- powerof10 = 10.0;
-
- while (type(c = pol_inchar()) == DIGIT) {
- if (sp < strsize)
- str[sp++] = c;
- frac += (double) (c - '0') / powerof10;
- powerof10 *= 10.0;
- }
- pol_ungetch (c);
-
- exp = 0.0;
- expsign = 1.0;
- c = pol_inchar();
- if (tolower(c) != 'e')
- pol_ungetch (c);
- else {
- if (sp < strsize)
- str[sp++] = c;
- if ((c = pol_inchar()) == PLUS) {
- if (sp < strsize)
- str[sp++] = c;
- expsign = 1.0;
- } else if (c == HYPHEN) {
- if (sp < strsize)
- str[sp++] = c;
- expsign = -1.0;
- } else if (type(c) != DIGIT) {
- --sp; /* erase 'e' */
- pol_ungetch (c);
- pol_ungetch ('e');
- goto getnumexit;
- } else
- pol_ungetch(c);
-
- exp = 0;
- while (type(c = pol_inchar()) == DIGIT) {
- if (sp < strsize)
- str[sp++] = c;
- exp = 10 * exp + (c - '0');
- }
- pol_ungetch (c);
- }
-
-getnumexit:
- str[sp] = EOS;
- *fnum = sign * (whole + frac) * pow (10.0, expsign * exp);
- if (*fnum < MIN_INT)
- *inum = MIN_INT;
- else if (*fnum > MAX_INT)
- *inum = MAX_INT;
- else
- *inum = (int) *fnum;
- return (TT_REAL);
-}
-
-static void
-eatline (void)
-{
- char term [2];
-
- term[0] = NEWLINE;
- term[1] = EOS;
- skiptok (term);
-}
-
-static int
-type ( /* return type of ASCII character */
- int c
-)
-{
- if (isalpha(c) || c == UNDERLIN)
- return (LETTER);
- else if (isdigit(c))
- return (DIGIT);
- else
- return (c);
-}
-
-/*----------------------------------------------------------------------*/
-/* */
-/* hash table routines. Kernighan & Ritchie */
-/* */
-/*----------------------------------------------------------------------*/
-
-/* inittable (table)
- * clear symbol table
-*/
-
-static void
-inittable (SYMBOL *table[])
-{
- int i;
-
- for (i = 0; i < HASHSIZE; i++)
- table[i] = NULL;
-}
-
-/* freetable (table)
- * free all memory allocated to table, then clear table
- */
-
-static void
-freetable (SYMBOL *table[])
-{
- int i;
- SYMBOL *p, *np;
-
- for (i = 0; i < HASHSIZE; i++) {
- np = table[i];
- while (np != NULL) {
- p = np->next;
- free (np);
- np = p;
- }
- }
- inittable (table);
-}
-
-static int
-hash ( /* form hash value of string s */
- char *s
-)
-{
- int hashval;
-
- for (hashval = 0; *s != EOS; )
- hashval += *s++;
- return (hashval % HASHSIZE);
-}
-
-/* Look for s in hash table */
-static SYMBOL *
-lookup ( SYMBOL *table[], char *s )
-{
- SYMBOL *np;
- SYMBOL *found = NULL;
-
- for (np = table[hash(s)]; np != NULL; np = np->next)
- if (strcasecmp(s, np->name) == 0) {
- found = np; /* found it */
- break;
- }
-
- return (found);
-}
-
-static SYMBOL *
-install (SYMBOL *table[], char *name, int def)
-{
- static char installerr[] = "install: out of memory";
- SYMBOL *np;
- int hashval;
-
- if ((np = lookup (table, name)) == NULL) { /* not found */
- np = (SYMBOL *) malloc (sizeof(*np));
- if (np == NULL) {
- synerr(installerr);
- return (NULL);
- }
- if ((np->name = strdup(name)) == NULL) {
- synerr(installerr);
- return (NULL);
- }
- str_lower (np->name);
- np->code = def;
- hashval = hash(np->name);
- np->next = table[hashval];
- table[hashval] = np;
- } else /* already there */
- np->code = def;
- return (np);
-}
-
-/*----------------------------------------------------------------------*/
-/* POL OUTPUT */
-/*----------------------------------------------------------------------*/
-
-#define MAXFILE 8
-
-static int currentf = -1; /* pointer to current fp */
-static FILE *filep[MAXFILE]; /* == NULL for string input */
-static char *fname[MAXFILE]; /* pointer to filename */
-static int linect[MAXFILE]; /* line count in file */
-
-static char inputline[MAXLINE]; /* current input line */
-static int lineptr; /* current position in inputline */
-
-static void
-outch (int c)
-{
- putchar (c);
-}
-
-
-static void inc_line(void)
-{
- if (currentf >= 0)
- ++linect[currentf];
-}
-
-static int getlinect(void)
-{
- return (linect[currentf]);
-}
-
-static void
-setlinect (int n)
-{
- if (currentf >= 0)
- linect[currentf] = n;
-}
-
-static void
-synerr (char *msg)
-{
- fputs (fname[currentf], stderr);
- fprintf(stderr, "%d", linect[currentf]);
- fputc (COLON, stderr);
- fputs (msg, stderr);
- fputc (NEWLINE, stderr);
-}
-
-/*----------------------------------------------------------------------*/
-/* POL INPUT */
-/*----------------------------------------------------------------------*/
-
-#define BUFSIZE 100
-static int bp = 0; /* pointer to next free position */
-static int buf[BUFSIZE]; /* pushed back input characters */
-
-/* pol_usefile - set source of POL input
- *
- * int source - source of input
- * P_USE_STR - have POL use strings as input
- * P_USE_FILE - use file. filename is in str
- *
-*/
-
-void
-pol_usefile (int source, char *fn)
-{
- FILE *fp;
-
- ++currentf;
- if (currentf >= MAXFILE) {
- --currentf;
- synerr ("files nested too deeply");
- return;
- }
-
- bp = 0; /* clear any pushed back input */
-
- if (source == P_USE_STR) {
- filep[currentf] = NULL;
- linect[currentf] = 1;
- } else if (source == P_USE_FILE) {
- if (fn == NULL || strlen(fn) == 0) {
- fp = stdin;
- } else if ((fp = fopen(fn, "r")) == NULL) {
- --currentf;
- synerr ("can't open file");
- return;
- }
- filep[currentf] = fp;
- linect[currentf] = 1;
- fname[currentf] = strdup (fn);
- }
-}
-
-void pol_closefile(void)
-{
- if (currentf >= 0) {
- if (filep[currentf] != NULL)
- fclose (filep[currentf]);
- --currentf;
- }
-}
-
-/*-----------------------------*/
-/* Lowest Level Input Routines */
-/*-----------------------------*/
-
-
-int pol_lookchar(void)
-{
- int c;
-
- c = pol_inchar();
- pol_ungetch (c);
- return (c);
-}
-
-int pol_inchar(void)
-{
- int c = 0;
-
- if (currentf < 0)
- return (EOF);
-
- while (currentf >= 0 && (c = pol_getch(filep[currentf])) == EOF && filep[currentf] != NULL) {
- pol_closefile ();
- }
-
- return (c);
-}
-
-/*--------------------------------------------------------------*/
-/* getch - get a (possibly pushed back) character */
-/* if fp == NULL, then get character from inputline */
-/*--------------------------------------------------------------*/
-
-static int
-pol_getch (FILE *fp)
-{
- int c;
-
- if (bp > 0)
- return (buf[--bp]);
-
- if (fp == NULL) {
- if ((c = inputline[lineptr]) == EOS)
- return (EOF);
- else {
- ++lineptr;
- return (c);
- }
- } else
- c = fgetc(fp);
-
- return (c);
-}
-
-/* push character back on input */
-void
-pol_ungetch (int c)
-{
- if (bp > BUFSIZE)
- sys_error (ERR_SEVERE, "too many characters pushed back [pol_ungetch]");
- else
- buf[bp++] = c;
-}
-
-
-/* push back string onto input */
-static void
-ungets (char *s)
-{
- int i;
-
- for (i = strlen(s) - 1; i >= 0; i--)
- pol_ungetch (s[i]);
-}
-
-int
-get_inputline (FILE *fp)
-{
- lineptr = 0;
- bp = 0;
- if (fgets (inputline, MAXLINE, fp) == NULL)
- return (EOF);
- else
- return (OK);
-}
-
-void
-set_inputline (char *line)
-{
- lineptr = 0;
- bp = 0;
- strncpy (inputline, line, MAXLINE);
-}
--- /dev/null
+/*****************************************************************************
+** FILE IDENTIFICATION
+**
+** POL - Problem Oriented Language
+**
+** This is part of the CTSim program
+** Copyright (C) 1983-2000 Kevin Rosenberg
+**
+** $Id: pol.cpp,v 1.1 2000/07/30 15:58:18 kevin Exp $
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU General Public License (version 2) as
+** published by the Free Software Foundation.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+** GNU General Public License for more details.
+**
+** You should have received a copy of the GNU General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+******************************************************************************/
+/* */
+/*----------------------------------------------------------------------*/
+
+#include <math.h>
+#include <stdio.h>
+#include <ctype.h>
+#include "ctsupport.h"
+#include "pol.h"
+
+
+static const int HASHSIZE=20;
+
+
+/* Tables words stored with install() & found with lookup() */
+static SYMBOL *skiptable[HASHSIZE]; /* words to ignore and skip */
+static SYMBOL *cmdtable[HASHSIZE]; /* pol parameter commands */
+static SYMBOL *usertable[HASHSIZE]; /* user defined symbols */
+
+static struct token_st token; /* current token */
+
+static struct metachar {
+ char eoc; /* end of command character */
+ char str; /* string delimiter */
+ char com; /* comment character */
+ char cmd; /* pol parameter command character */
+ char prg; /* program load character */
+ char con; /* continuation across newline character */
+ char out; /* character that delimits output to terminal */
+ char ter; /* character indicates insertion of input from terminal */
+ char inb; /* input from graphics device */
+} meta;
+
+/* current pol state */
+
+static struct pol_st {
+ char skipchars[MAXSKIPCHAR]; /* characters to skip */
+ int nl_eoc; /* TRUE if newline character ends a command */
+ int trace; /* TRUE if trace is on */
+} pol;
+
+struct key {
+ char *keyword;
+ int code;
+};
+
+/* internal codes for pol commands */
+
+#define PC_EOC 1
+#define PC_STR 2
+#define PC_COM 3
+#define PC_CMD 4
+#define PC_PRG 5
+#define PC_CON 6
+#define PC_OUT 7
+#define PC_TER 8
+#define PC_INB 9
+#define PC_NL_EOC 10
+#define PC_NL_NEOC 11
+#define PC_TRON 12
+#define PC_TROFF 13
+#define PC_FILE 14
+#define PC_DUMP 15
+
+static struct key cmdlist[] = {
+ { "eoc", PC_EOC,},
+ { "str", PC_STR,},
+ { "com", PC_COM,},
+ { "cmd", PC_CMD,},
+ { "prg", PC_PRG,},
+ { "con", PC_CON,},
+ { "out", PC_OUT,},
+ { "ter", PC_TER,},
+ { "inb", PC_INB,},
+
+ { "nl_eoc",PC_NL_EOC,},
+ { "nl_neoc", PC_NL_NEOC,},
+ { "tron", PC_TRON,},
+ { "troff", PC_TROFF,},
+ { "file", PC_FILE,},
+ { "dump", PC_DUMP,},
+};
+
+#define NUMCMD (sizeof(cmdlist) / sizeof (struct key))
+
+static int skiptok(char term[]);
+static int pol_tok(struct token_st *token);
+static void dumptok(struct token_st *token);
+
+
+static int getpol_tok(struct token_st *token);
+static int getcmd(void);
+static int gettok (TOKEN *tok);
+static void getblank(char *s, int toksiz);
+static int getalpha(char *s, int toksiz);
+static void getquote(char *qs, int toksiz);
+static void getescape(char *s, int delim, int toksiz);
+static int getnumber (char str[], int strsize, double *fnum, int *inum);
+static void eatline(void);
+static int type(int c);
+static void inittable(SYMBOL *table[]);
+static void freetable(SYMBOL *table[]);
+static int hash(char *s);
+static SYMBOL *lookup(SYMBOL *table[], char *s);
+static SYMBOL *install(SYMBOL *table[], char *s, int def);
+static void outch(int c);
+static void inc_line(void);
+static int getlinect(void);
+static void setlinect(int n);
+static void synerr(char *msg);
+static int pol_getch(FILE *fp);
+static void ungets(char *s);
+
+
+void pol_init (void)
+{
+ meta.eoc = SEMICOL;
+ meta.str = DQUOTE;
+ meta.com = SHARP;
+ meta.cmd = EXCLAM;
+ meta.prg = ATSIGN;
+ meta.con = AMPERSAND;
+ meta.out = DOLLAR;
+ meta.ter = PERCENT;
+ meta.inb = LBRACK;
+
+ pol.nl_eoc = TRUE;
+ pol.skipchars[0] = EOS;
+
+ inittable (cmdtable); /* initialize symbol tables */
+ inittable (usertable);
+ inittable (skiptable);
+
+ for (unsigned int i = 0; i < NUMCMD; i++)
+ install (cmdtable, cmdlist[i].keyword, cmdlist[i].code);
+
+ token.ready = FALSE; /* no token read yet */
+}
+
+/* pol_skpword (w)
+ *
+ * char *w - word for pol to ignore and skip over in input
+ *
+ * pol_tok() compares all tokens to words given to this routine. If it finds it,
+ * it will immediately read another token.
+ */
+
+void
+pol_skpword (char *w)
+{
+ if (install (skiptable, w, 0) == NULL)
+ synerr ("Too many skip words defined");
+}
+
+/* pol_skpchar (s)
+ *
+ * skip all characters that appear in string s
+ */
+void
+pol_skpchar (char *s)
+{
+ strncpy (pol.skipchars, s, MAXSKIPCHAR);
+}
+
+/* pol_install (str, code)
+ *
+ * char *str - token string to install
+ * int code - code to return for token
+ *
+ * pol_tok() looks for these user defined tokens. If it finds one,
+ * it stores the tokens code in the token structure and returns TT_USERTOK
+ */
+int
+pol_install (char *str, int code)
+{
+ if (install (usertable, str, code) == NULL)
+ {
+ synerr ("Out ot memory installing user tokens");
+ return (FALSE);
+ }
+
+ return(TRUE);
+}
+
+/* get_word - matches tokens on a letter by letter basis
+ *
+ * char *search - string to search for
+ * int nlet - maximum number of chars to search for match
+ */
+
+int
+pol_word (char *search, int nlet)
+{
+ pol_tok (&token);
+ if (pol.trace == TRUE)
+ printf ("matching current token %s against word %s\n", token.tokstr, search);
+
+ if (strncasecmp (search, token.tokstr, nlet) == 0) {
+ dumptok (&token);
+ return (TRUE);
+ } else
+ return (FALSE);
+}
+
+/* pol_usertok (str,code)
+ * see if current token is a user defined token set with pol_install()
+ *
+ * char *str - token string as read from input
+ * int *code - returned code for user defined symbol
+ * return value - TRUE if current token has been user defined
+ * FALSE if current token is not user defined
+ */
+int
+pol_usertok (char *str, int *code)
+{
+ pol_tok (&token);
+
+ if (pol.trace == TRUE)
+ printf ("checking if current token '%s' is user defined\n", token.tokstr);
+
+ if (token.type == TT_USERTOK) {
+ *code = token.code;
+ strcpy (str, token.tokstr);
+ dumptok (&token);
+ return (TRUE);
+ } else {
+ *code = 0;
+ return (FALSE);
+ }
+}
+
+/* isstring (s) - returns TRUE if current token is a string
+ *
+ * char *s - pointer to place to store token string
+*/
+
+int
+pol_string (char *str)
+{
+ pol_tok (&token);
+
+ if (token.type == TT_STRING) {
+ strcpy (str, token.tokstr);
+ dumptok (&token);
+ return (TRUE);
+ } else
+ return (FALSE);
+}
+
+/* pol_integer - test for an integer
+ *
+ * int *n: returned integer value
+ * int typecode = TT_INT if accept only integer values
+ * = TT_REAL if accept both real and integer values
+ * int boundcode= TRUE if force to lie between boundries
+ * = FALSE can take any value it likes
+ * int bb1: lower bound
+ * int bb2: upper bound
+*/
+int
+pol_integer (int *n, int typecode, int boundcode, int bb1, int bb2)
+{
+ pol_tok (&token);
+
+ if (pol.trace == TRUE)
+ printf ("checking if current token %s is an integer\n", token.tokstr);
+
+ if (token.type == TT_INT || token.type == TT_REAL) {
+ if (boundcode == TRUE) {
+ if (token.inum < bb1)
+ *n = bb1;
+ else if (token.inum > bb2)
+ *n = bb2;
+ else
+ *n = token.inum;
+ } else
+ *n = token.inum;
+ dumptok (&token);
+ return (TRUE);
+ }
+ *n = 0;
+ return (FALSE);
+}
+
+int
+pol_float (double *n, double typecode, double boundcode, double bb1, double bb2)
+{
+ pol_tok (&token);
+
+ if (pol.trace == TRUE)
+ printf ("checking if current token %s is an floating point number\n", token.tokstr);
+
+ if (token.type == TT_INT || token.type == TT_REAL) {
+ if (boundcode == TRUE) {
+ if (token.fnum < bb1)
+ *n = bb1;
+ else if (token.fnum > bb2)
+ *n = bb2;
+ else
+ *n = token.fnum;
+ } else
+ *n = token.fnum;
+ dumptok (&token);
+ return (TRUE);
+ }
+ *n = 0.0;
+ return (FALSE);
+}
+
+/*----------------------------------------------------------------------*/
+/* pol_skip() - skip over any token except for end of command sequence */
+/* */
+/* returns TRUE if succesful skip */
+/* returns FALSE if already at end of command or EOF */
+/*----------------------------------------------------------------------*/
+
+int pol_skip(void)
+{
+ char term[5]; /* string of characters not to skip */
+
+ term[0] = meta.eoc;
+ if (pol.nl_eoc == TRUE) {
+ term[1] = NEWLINE;
+ term[2] = EOS;
+ } else
+ term[1] = EOS;
+
+ return (skiptok (term));
+}
+
+void pol_reader(void)
+{
+ while (pol_skip() == TRUE)
+ ;
+
+ dumptok (&token); /* skip end of command token */
+}
+
+/* skiptok (term) - skip a token unless the first character of a token is
+ * in the string of terminators, term.
+ * char *term - string of termination characters, don't skip these characters
+ * skiptok() also does NOT skip TT_EOF
+ * returns (TRUE) if succesful skip of a token
+ * returns (FALSE) if didn't skip, read termination character or TT_EOF
+ */
+
+static int
+skiptok (char term[])
+{
+ pol_tok (&token);
+
+ if (token.type == TT_EOF
+ || (token.type == TT_SPECLCHAR && strchr(term, token.tokstr[0]) != NULL))
+ return (FALSE);
+ else {
+ dumptok (&token);
+ return (TRUE);
+ }
+}
+
+static int
+pol_tok (struct token_st *token)
+{
+ if (token->ready == FALSE)
+ getpol_tok(token);
+ else
+ if (token->type == TT_EOF && pol_lookchar() != EOF)
+ getpol_tok(token);
+ return (token->type);
+}
+
+static void
+dumptok (struct token_st *token)
+{
+ if (token->ready == FALSE)
+ getpol_tok(token);
+ token->ready = FALSE;
+}
+
+static int
+getpol_tok (struct token_st *token)
+{
+ SYMBOL *sym;
+
+ token->ready = FALSE;
+nexttok:
+ gettok (token);
+
+ if (token->type == TT_BLANK)
+ goto nexttok;
+ if (token->type == TT_SPECLCHAR) {
+ if (strchr(pol.skipchars, token->tokstr[0]) != NULL)
+ goto nexttok;
+ if (token->tokstr[0] == NEWLINE)
+ goto nexttok;
+ if (token->tokstr[0] == meta.cmd) {
+ getcmd();
+ goto nexttok;
+ }
+ if (token->tokstr[0] == meta.com) { /* skip comment */
+ eatline ();
+ goto nexttok;
+ }
+ if (token->tokstr[0] == meta.out) {
+ getescape(token->tokstr, meta.out, MAXTOK);
+ fputs (token->tokstr, stderr);
+ goto nexttok;
+ }
+ if (token->tokstr[0] == meta.con) { /* continuation across NEWLINE */
+ while (pol_lookchar() == BLANK || pol_lookchar() == TAB)
+ pol_inchar();
+ if (pol_lookchar() == NEWLINE)
+ pol_inchar();
+ }
+ if (token->tokstr[0] == meta.ter) { /* get input from terminal */
+ pol_usefile (P_USE_FILE, "");
+ pol_tok (token);
+ pol_closefile();
+ return (token->type);
+ }
+ }
+
+ /* look for filler words */
+
+ if (lookup (skiptable, token->tokstr) != NULL) /* ignore words in skip table */
+ goto nexttok;
+
+ /* look for user defined symbols */
+
+ if ((sym = lookup (usertable, token->tokstr)) != NULL) {
+ token->type = TT_USERTOK;
+ token->code = sym->code;
+ } else
+ token->code = 0;
+
+ if (pol.trace == TRUE)
+ printf ("Read token '%s', type = %d\n", token->tokstr, token->type);
+
+ return (token->type);
+}
+
+
+static int getcmd(void)
+{
+ int tt, found;
+ char str[MAXTOK+1];
+ SYMBOL *cmd;
+ TOKEN tok;
+
+ tt = getalpha (str, MAXTOK);
+ if (tt == TT_ERROR) {
+ synerr ("error in pol parameter command");
+ pol_reader();
+ return(FALSE);
+ }
+ if ((cmd = lookup (cmdtable,str)) == NULL) {
+ synerr ("unrecognized command");
+ pol_reader();
+ return (FALSE);
+ } else {
+ found = FALSE;
+ switch (cmd->code) {
+ case PC_TRON:
+ pol.trace = TRUE;
+ found = TRUE;
+ break;
+ case PC_TROFF:
+ pol.trace = FALSE;
+ found = TRUE;
+ break;
+ case PC_FILE:
+ found = TRUE;
+ tt = gettok (&tok);
+ pol_usefile (P_USE_FILE, tok.tokstr);
+ break;
+ case PC_NL_EOC:
+ found = TRUE;
+ pol.nl_eoc = TRUE;
+ break;
+ case PC_NL_NEOC:
+ found = TRUE;
+ pol.nl_eoc = FALSE;
+ break;
+ case PC_DUMP:
+ found = TRUE;
+ printf("eoc = %c str = %c com = %c cmd = %c prg = %c\n",
+ meta.eoc, meta.str, meta.com, meta.cmd, meta.prg);
+ printf("con = %c out = %c ter = %c inb = %c\n",
+ meta.con, meta.out, meta.ter, meta.inb);
+ break;
+ }
+ if (found == FALSE) {
+ tt = gettok (&tok);
+ if (tt != TT_SPECLCHAR) {
+ synerr("illegal command character");
+ return (FALSE);
+ }
+ switch(cmd->code) {
+ case PC_EOC:
+ meta.eoc = tok.tokstr[0];
+ break;
+ case PC_STR:
+ meta.str = tok.tokstr[0];
+ break;
+ case PC_COM:
+ meta.com = tok.tokstr[0];
+ break;
+ case PC_CMD:
+ meta.cmd = tok.tokstr[0];
+ break;
+ case PC_PRG:
+ meta.prg = tok.tokstr[0];
+ break;
+ case PC_CON:
+ meta.con = tok.tokstr[0];
+ break;
+ case PC_OUT:
+ meta.out = tok.tokstr[0];
+ break;
+ case PC_TER:
+ meta.ter = tok.tokstr[0];
+ break;
+ case PC_INB:
+ meta.inb = tok.tokstr[0];
+ break;
+ default:
+ printf("command not implemented\n");
+ break;
+ } /* switch (tok->type) */
+ } /* if (found == FALSE) */
+ pol_reader(); /* clean up command */
+ } /* if legal command */
+
+ return (TRUE);
+}
+
+
+static int
+gettok (TOKEN *tok)
+{
+ int c, toktype;
+ int inum;
+ double fnum;
+ int toksiz = MAXTOK; /* maximum length of token string */
+
+ while ((c = pol_inchar()) == BLANK || c == TAB)
+ ;
+ pol_ungetch (c);
+
+ c = pol_lookchar();
+ toktype = type(c);
+
+ fnum = 0.0;
+ inum = 0;
+
+ if (c == BLANK || c == TAB) { /* skip white space */
+ getblank(tok->tokstr, toksiz);
+ toktype = TT_BLANK;
+ } else if (toktype == LETTER) {
+ toktype = getalpha (tok->tokstr, toksiz);
+ } else if (c == meta.str) { /* quoted string */
+ getquote (tok->tokstr, toksiz);
+ toktype = TT_STRING;
+ } else if (type(c) == DIGIT || c == PLUS || c == HYPHEN || c == PERIOD) {
+ toktype = getnumber (tok->tokstr, toksiz, &fnum, &inum);
+ } else if (c == EOF) {
+ tok->tokstr[0] = EOS;
+ toktype = TT_EOF;
+ } else {
+ c = pol_inchar();
+ tok->tokstr[0] = c;
+ tok->tokstr[1] = EOS;
+ toktype = TT_SPECLCHAR;
+ }
+
+ tok->type = toktype;
+ tok->ready = TRUE;
+ if (tok->type == TT_REAL || tok->type == TT_INT) {
+ tok->fnum = fnum;
+ tok->inum = inum;
+ } else {
+ tok->fnum = 0.0;
+ tok->inum = 0;
+ }
+
+ return (toktype);
+}
+
+
+static void
+getblank (char *s, int toksiz)
+{
+ int c;
+
+ while ((c = pol_inchar()) == BLANK || c == TAB)
+ ;
+ pol_ungetch(c);
+
+ s[0] = BLANK;
+ s[1] = EOS;
+}
+
+
+static int
+getalpha (char *s, int toksiz)
+{
+ int i, chartype, alphatype;
+
+ if (type(pol_lookchar()) != LETTER) {
+ s[0] = EOS;
+ return (TT_ERROR);
+ }
+
+ alphatype = TT_ALPHA;
+ for (i = 0; i < toksiz; i++) { /* get alphanumeric token */
+ s[i] = pol_inchar();
+ chartype = type (s[i]);
+ if (chartype != LETTER && chartype != DIGIT)
+ break;
+ if (chartype == DIGIT)
+ alphatype = TT_ALPNUM;
+ }
+ pol_ungetch(s[i]);
+
+ if (i >= toksiz)
+ synerr("token too long.");
+
+ s[i] = EOS; /* terminate token */
+ return (alphatype);
+}
+
+
+/* getquote - get quoted string from file */
+/* have already gotten delimiter in qs[0] */
+static void
+getquote (char *qs, int toksiz)
+{
+ int delim;
+
+ delim = pol_inchar(); /* char = delimiter */
+ getescape(qs, delim, toksiz);
+}
+
+
+static void
+getescape ( /* reads up to delim */
+ char *s,
+ int delim,
+ int toksiz
+)
+{
+ int i, c;
+
+ for (i = 0; (c = pol_inchar()) != delim; i++) {
+ if (c == NEWLINE) {
+ synerr ("Missing closing delimiter.");
+ break;
+ }
+ if (i >= toksiz) {
+ synerr("string too long.");
+ break;
+ }
+ if (c == EOF) {
+ pol_ungetch(c);
+ synerr("end of file inside quotation");
+ break;
+ } else if (c == BSLASH) { /* escape character */
+ s[i++] = c;
+ c = pol_inchar(); /* get escaped character */
+ }
+ s[i] = c;
+ }
+ s[i] = EOS;
+}
+
+void
+gettext (char *str, int lim)
+{
+ int c, i;
+
+ while ((c = pol_inchar()) == BLANK || c == TAB)
+ ;
+ pol_ungetch (c);
+
+ for (i = 0; i < lim && (c = pol_inchar()) != EOF && c != NEWLINE; i++)
+ str[i] = c;
+ pol_ungetch (c);
+ str[i] = EOS;
+}
+
+/*----------------------------------------------*/
+/* Get a number for gettok() */
+/*----------------------------------------------*/
+
+static int
+getnumber (
+ char str[], /* string to return token in */
+ int strsize, /* maximum length of token string */
+ double *fnum, /* floating point value of number read */
+ int *inum /* integer value of number read */
+)
+{
+ int c, sp, isSigned;
+ double sign, whole, frac, powerof10, exp, expsign;
+
+ sp = 0;
+ sign = 1.0;
+ isSigned = FALSE; /* TRUE if number prefixed by '+' or '-' */
+ *fnum = 0.0;
+ *inum = 0;
+ str[0] = EOS;
+
+ c = pol_inchar();
+ if (c == HYPHEN) {
+ str[sp++] = c;
+ isSigned = TRUE;
+ sign = -1.0;
+ } else if (c == PLUS) {
+ str[sp++] = c;
+ isSigned = TRUE;
+ sign = 1.0;
+ } else if (c == PERIOD) {
+ if (type(pol_lookchar()) != DIGIT) {
+ str[0] = PERIOD;
+ str[1] = EOS;
+ return (TT_SPECLCHAR);
+ } else
+ pol_ungetch (PERIOD);
+ } else if (type(c) != DIGIT) {
+ pol_ungetch (c);
+ return (TT_ERROR);
+ } else
+ pol_ungetch (c);
+
+ if (isSigned == TRUE) {
+ c = pol_lookchar();
+ if (c == PERIOD) {
+ pol_inchar(); /* get period */
+ c = pol_lookchar(); /* look at character past period */
+ pol_ungetch (PERIOD); /* put back period */
+ if (type(c) != DIGIT) {
+ str[sp] = EOS;
+ return (TT_SPECLCHAR);
+ }
+ } else if (type (c) != DIGIT) {
+ str[sp] = EOS;
+ return (TT_SPECLCHAR);
+ }
+ }
+
+ whole = 0.0;
+ while (type(c = pol_inchar()) == DIGIT) {
+ if (sp < strsize)
+ str[sp++] = c;
+ whole = 10.0 * whole + (c - '0');
+ }
+ pol_ungetch (c); /* put back non-numeric character */
+
+ if (c != PERIOD && tolower(c) != 'e') {
+ str[sp] = EOS;
+ *fnum = whole * sign;
+ if (*fnum < MIN_INT)
+ *inum = MIN_INT;
+ else if (*fnum > MAX_INT)
+ *inum = MAX_INT;
+ else
+ *inum = (int) *fnum;
+ return (TT_INT);
+ }
+
+ if (pol_lookchar() == PERIOD) {
+ pol_inchar();
+ if (sp < strsize)
+ str[sp++] = PERIOD;
+ }
+
+ frac = 0.0;
+ powerof10 = 10.0;
+
+ while (type(c = pol_inchar()) == DIGIT) {
+ if (sp < strsize)
+ str[sp++] = c;
+ frac += (double) (c - '0') / powerof10;
+ powerof10 *= 10.0;
+ }
+ pol_ungetch (c);
+
+ exp = 0.0;
+ expsign = 1.0;
+ c = pol_inchar();
+ if (tolower(c) != 'e')
+ pol_ungetch (c);
+ else {
+ if (sp < strsize)
+ str[sp++] = c;
+ if ((c = pol_inchar()) == PLUS) {
+ if (sp < strsize)
+ str[sp++] = c;
+ expsign = 1.0;
+ } else if (c == HYPHEN) {
+ if (sp < strsize)
+ str[sp++] = c;
+ expsign = -1.0;
+ } else if (type(c) != DIGIT) {
+ --sp; /* erase 'e' */
+ pol_ungetch (c);
+ pol_ungetch ('e');
+ goto getnumexit;
+ } else
+ pol_ungetch(c);
+
+ exp = 0;
+ while (type(c = pol_inchar()) == DIGIT) {
+ if (sp < strsize)
+ str[sp++] = c;
+ exp = 10 * exp + (c - '0');
+ }
+ pol_ungetch (c);
+ }
+
+getnumexit:
+ str[sp] = EOS;
+ *fnum = sign * (whole + frac) * pow (10.0, expsign * exp);
+ if (*fnum < MIN_INT)
+ *inum = MIN_INT;
+ else if (*fnum > MAX_INT)
+ *inum = MAX_INT;
+ else
+ *inum = (int) *fnum;
+ return (TT_REAL);
+}
+
+static void
+eatline (void)
+{
+ char term [2];
+
+ term[0] = NEWLINE;
+ term[1] = EOS;
+ skiptok (term);
+}
+
+static int
+type ( /* return type of ASCII character */
+ int c
+)
+{
+ if (isalpha(c) || c == UNDERLIN)
+ return (LETTER);
+ else if (isdigit(c))
+ return (DIGIT);
+ else
+ return (c);
+}
+
+/*----------------------------------------------------------------------*/
+/* */
+/* hash table routines. Kernighan & Ritchie */
+/* */
+/*----------------------------------------------------------------------*/
+
+/* inittable (table)
+ * clear symbol table
+*/
+
+static void
+inittable (SYMBOL *table[])
+{
+ int i;
+
+ for (i = 0; i < HASHSIZE; i++)
+ table[i] = NULL;
+}
+
+/* freetable (table)
+ * free all memory allocated to table, then clear table
+ */
+
+static void
+freetable (SYMBOL *table[])
+{
+ int i;
+ SYMBOL *p, *np;
+
+ for (i = 0; i < HASHSIZE; i++) {
+ np = table[i];
+ while (np != NULL) {
+ p = np->next;
+ free (np);
+ np = p;
+ }
+ }
+ inittable (table);
+}
+
+static int
+hash ( /* form hash value of string s */
+ char *s
+)
+{
+ int hashval;
+
+ for (hashval = 0; *s != EOS; )
+ hashval += *s++;
+ return (hashval % HASHSIZE);
+}
+
+/* Look for s in hash table */
+static SYMBOL *
+lookup ( SYMBOL *table[], char *s )
+{
+ SYMBOL *np;
+ SYMBOL *found = NULL;
+
+ for (np = table[hash(s)]; np != NULL; np = np->next)
+ if (strcasecmp(s, np->name) == 0) {
+ found = np; /* found it */
+ break;
+ }
+
+ return (found);
+}
+
+static SYMBOL *
+install (SYMBOL *table[], char *name, int def)
+{
+ static char installerr[] = "install: out of memory";
+ SYMBOL *np;
+ int hashval;
+
+ if ((np = lookup (table, name)) == NULL) { /* not found */
+ np = (SYMBOL *) malloc (sizeof(*np));
+ if (np == NULL) {
+ synerr(installerr);
+ return (NULL);
+ }
+ if ((np->name = strdup(name)) == NULL) {
+ synerr(installerr);
+ return (NULL);
+ }
+ str_lower (np->name);
+ np->code = def;
+ hashval = hash(np->name);
+ np->next = table[hashval];
+ table[hashval] = np;
+ } else /* already there */
+ np->code = def;
+ return (np);
+}
+
+/*----------------------------------------------------------------------*/
+/* POL OUTPUT */
+/*----------------------------------------------------------------------*/
+
+#define MAXFILE 8
+
+static int currentf = -1; /* pointer to current fp */
+static FILE *filep[MAXFILE]; /* == NULL for string input */
+static char *fname[MAXFILE]; /* pointer to filename */
+static int linect[MAXFILE]; /* line count in file */
+
+static char inputline[MAXLINE]; /* current input line */
+static int lineptr; /* current position in inputline */
+
+static void
+outch (int c)
+{
+ putchar (c);
+}
+
+
+static void inc_line(void)
+{
+ if (currentf >= 0)
+ ++linect[currentf];
+}
+
+static int getlinect(void)
+{
+ return (linect[currentf]);
+}
+
+static void
+setlinect (int n)
+{
+ if (currentf >= 0)
+ linect[currentf] = n;
+}
+
+static void
+synerr (char *msg)
+{
+ fputs (fname[currentf], stderr);
+ fprintf(stderr, "%d", linect[currentf]);
+ fputc (COLON, stderr);
+ fputs (msg, stderr);
+ fputc (NEWLINE, stderr);
+}
+
+/*----------------------------------------------------------------------*/
+/* POL INPUT */
+/*----------------------------------------------------------------------*/
+
+#define BUFSIZE 100
+static int bp = 0; /* pointer to next free position */
+static int buf[BUFSIZE]; /* pushed back input characters */
+
+/* pol_usefile - set source of POL input
+ *
+ * int source - source of input
+ * P_USE_STR - have POL use strings as input
+ * P_USE_FILE - use file. filename is in str
+ *
+*/
+
+void
+pol_usefile (int source, char *fn)
+{
+ FILE *fp;
+
+ ++currentf;
+ if (currentf >= MAXFILE) {
+ --currentf;
+ synerr ("files nested too deeply");
+ return;
+ }
+
+ bp = 0; /* clear any pushed back input */
+
+ if (source == P_USE_STR) {
+ filep[currentf] = NULL;
+ linect[currentf] = 1;
+ } else if (source == P_USE_FILE) {
+ if (fn == NULL || strlen(fn) == 0) {
+ fp = stdin;
+ } else if ((fp = fopen(fn, "r")) == NULL) {
+ --currentf;
+ synerr ("can't open file");
+ return;
+ }
+ filep[currentf] = fp;
+ linect[currentf] = 1;
+ fname[currentf] = strdup (fn);
+ }
+}
+
+void pol_closefile(void)
+{
+ if (currentf >= 0) {
+ if (filep[currentf] != NULL)
+ fclose (filep[currentf]);
+ --currentf;
+ }
+}
+
+/*-----------------------------*/
+/* Lowest Level Input Routines */
+/*-----------------------------*/
+
+
+int pol_lookchar(void)
+{
+ int c;
+
+ c = pol_inchar();
+ pol_ungetch (c);
+ return (c);
+}
+
+int pol_inchar(void)
+{
+ int c = 0;
+
+ if (currentf < 0)
+ return (EOF);
+
+ while (currentf >= 0 && (c = pol_getch(filep[currentf])) == EOF && filep[currentf] != NULL) {
+ pol_closefile ();
+ }
+
+ return (c);
+}
+
+/*--------------------------------------------------------------*/
+/* getch - get a (possibly pushed back) character */
+/* if fp == NULL, then get character from inputline */
+/*--------------------------------------------------------------*/
+
+static int
+pol_getch (FILE *fp)
+{
+ int c;
+
+ if (bp > 0)
+ return (buf[--bp]);
+
+ if (fp == NULL) {
+ if ((c = inputline[lineptr]) == EOS)
+ return (EOF);
+ else {
+ ++lineptr;
+ return (c);
+ }
+ } else
+ c = fgetc(fp);
+
+ return (c);
+}
+
+/* push character back on input */
+void
+pol_ungetch (int c)
+{
+ if (bp > BUFSIZE)
+ sys_error (ERR_SEVERE, "too many characters pushed back [pol_ungetch]");
+ else
+ buf[bp++] = c;
+}
+
+
+/* push back string onto input */
+static void
+ungets (char *s)
+{
+ int i;
+
+ for (i = strlen(s) - 1; i >= 0; i--)
+ pol_ungetch (s[i]);
+}
+
+int
+get_inputline (FILE *fp)
+{
+ lineptr = 0;
+ bp = 0;
+ if (fgets (inputline, MAXLINE, fp) == NULL)
+ return (EOF);
+ else
+ return (OK);
+}
+
+void
+set_inputline (char *line)
+{
+ lineptr = 0;
+ bp = 0;
+ strncpy (inputline, line, MAXLINE);
+}