⟦b962bf620⟧

TextFile

%{
#include "unixstat.h"
PGM(dm,Data Manipulation,5.0,3/2/85)
/* Copyright (c) 1982 Gary Perlman (see Copyright file) */

/*
	MSDOS note: in dm.c (the output from yacc on dm.y),
	you must change the line:
		yyval = yypv[1];
	to:
		yyval.ex = yypv[1].ex;
	The reason is that the Lattice C compiler cannot do union assignments.
*/

/*
dm is a data manipulator designed to manipulate files of columns of number and
strings.  The major components of this program are:
	(1) a parser, built by yacc, called yyparse.
	(2) a scanner, yylex, called by yyparse.
	(3) a parse tree node function, called by yyparse.
	(4) a function, eval, that evaluates the parse trees.
	(5) a main that calls I/O routines and the control loop.
The following section is a bunch of global declarations that will be put
literally into the program, y.tab.c by yacc.
*/

#define MAXEXPR      100             /* maximum number of expressions */
#define MAXSTRING    32              /* maximum length of input string */
#define MAXCOL       100             /* maximum number of input columns */
#define MAXCONST     100             /* maximum number of constants */
#define LOGe10       2.302585092994  /* used for L function */
#define FLOATPTR     0               /* codes for parse tree node types */
#define OPERATOR     1
#define STRINGOP     2
#define STRINGPTR    3
typedef	int lgl;                     /* no lgl  type in C */
#define FALSE        0
#define TRUE         1
#define PARSERROR    1               /* returned by yyparse on error */
/*
The following few numbers are reserved by dm to signal special conditions by
being returned by various routines.  They are hopefully numbers that no
expressions would ever evaluate to.
*/
#define	LARGE         9999999999999.0      /* a large number */
#define	SUPPRESS     -1125899906842624.    /* suppress output */
#define	STRINGFLAG   -8888888888888777.0   /* returned by eval */
#define	NIL          -998888677484837274.  /* cause nil output */
#define	EXITFLAG     -99999999999999.9     /* cause exit */

char	*N_KILL     = "KILL";
char	*N_EXIT     = "EXIT";
char	*N_NIL      = "NIL";
char	*N_INLINE   = "INLINE";
char	*N_OUTLINE  = "OUTLINE";
char	*N_INPUT    = "INPUT";
char	*N_N        = "N";
char	*N_SUM      = "SUM";
char	*N_RAND     = "RAND";
char	*N_ABS      = "abs";
char	*N_FLOOR    = "floor";
char	*N_CEIL     = "ceil";
char	*N_EXP      = "exp";
char	*N_LOG      = "log";
char	*N_LOG10    = "Log";

char	Outpipe = 0;                       /* true if output is piped */
FILE	*Infile;                           /* data read from here */
char	Inputline[BUFSIZ];                 /* INPUT read into here */
FILE	*Outfile;                          /* output from dm */
char	*Evalstr[MAXCOL+1];                /* ptrs to strings from eval */
char	Str[MAXCOL+1][MAXSTRING];          /* columns from each dataline */
char	*Expra;                            /* ptr to each expression */
typedef	union
	{
	int 	opr;        /* if operator or stringop */
	double	*num;       /* if FLOATPTR */
	char	*str;       /* if STRINGOP */
	} STUFF;
STUFF	Tmp1, Tmp2;  /* used in the parser to cast operators */
typedef struct enode        /* expression node in tree */
	{
	int 	etype;          /* type of node */
	STUFF	contents;
	struct	enode *lchild;
	struct	enode *rchild;
	} ENODE;
#define	ENULL ((ENODE *) NULL)
ENODE	*Expr[MAXEXPR+1];           /* ptr to each parse tree */
double	Input[MAXCOL+1];            /* input numbers */
#define	INLINE (Input[0])           /* input line number stored here */
lgl 	Usenumber[MAXCOL+1];        /* true is Input[i] is used */
int 	Usecols;                    /* maximum col number accessed */
double	Output[MAXEXPR+1];          /* output numbers */
#define	OUTLINE (Output[0])         /* output line number stored here */
double	Const[MAXCONST];            /* constants stored here */
int 	Nconst;                     /* number of constants */
double	Nil = NIL;                  /* flagged by NIL */
double	Suppress  = SUPPRESS;       /* flagged by KILL */
double	Stringflag = STRINGFLAG;    /* eval returns string */
double	Exitflag = EXITFLAG;        /* flagged by EXIT */
double	Randu;                      /* uniform rand num */
extern	double	Maxrand;            /* set by initrand */
lgl 	Userand;                    /* true if Randu is used */
double	N;                          /* number of input cols */
double	Sum;                        /* sum of input cols */
int 	Should_output[MAXEXPR+1];   /* used with X */
int 	Exprno;                     /* expression number */
int 	Nexpr;                      /* number of expressions */
char	*malloc (), *strcpy ();
%}

/*                    G R A M M A R                       */
/*
First is the set of precedences and associativities, followed by the grammar
Actions are associated with each part of the grammar matched.  These amount
to creating an enode representing the expression parsed, created by node.
One notable feature about the grammar is that it uses the same symbols for
comparing both strings and numbers, the difference being made explicit in
the actions for the string comparison functions.
*/
%union { /* union of the data types the parser will deal with */
	int 	opr;
	char	*str;
	double	*num;
	ENODE	*ex;
	}
%type <ex> expr string stringexpr
%token <num> NUMBER                          /* returned by yylex for numbers */
%token <str> STRING                          /* returned by yylex for strings */
%token <opr> STRINDEX                        /* string index operator flag */
%left <opr> '?' ':' IF THEN ELSE             /* if then else */
%left <opr> '|' NOR                          /* logical or */
%left <opr> '&' NAND                         /* logical and */
%nonassoc <opr> '!'                          /* logical not */
%nonassoc <opr> EQ NE GE GT LE LT NOTIN 'C'  /* comparators */
%left  <opr> '+' '-'                         /* plus and minus */
%left  <opr> '*' '/' '%'                     /* mult, div, mod */
%right <opr> '^'                             /* exponentiation */
%nonassoc <opr> UMINUS                       /* unary minus */
%nonassoc <opr> '#' 'l' 'L' 'e' 'a' 'f' 'c'  /* unary functions */
%%
/*                     P R O D U C T I O N S                         */
start:
	stringexpr
		{
		Expr[Exprno] = $1;
		};
stringexpr :
	expr
		{
		$$ = $1;
		}|
	string
		{
		$$ = $1;
		};
expr :
	'x' '[' expr ']'
		{
		Tmp1.opr = 'x';
		$$ = node (&Tmp1, OPERATOR, ENULL, $3);
		}|
	'y' '[' expr ']'
		{
		Tmp1.opr = 'y';
		$$ = node (&Tmp1, OPERATOR, ENULL, $3);
		}|
	'('  expr ')'
		{
		$$ = $2;
		}|
	expr '+' expr
		{
		Tmp1.opr = '+';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr '-' expr
		{
		Tmp1.opr = '-';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr '*' expr
		{
		Tmp1.opr = '*';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr '%' expr
		{
		Tmp1.opr = '%';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr '/' expr
		{
		Tmp1.opr = '/';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr '^' expr
		{
		Tmp1.opr = '^';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	string EQ string
		{
		Tmp1.opr = '=';
		$$ = node (&Tmp1, STRINGOP, $1, $3);
		}|
	string NE string
		{
		Tmp1.opr = '!';
		Tmp2.opr = '=';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, STRINGOP, $1, $3));
		}|
	expr EQ expr
		{
		Tmp1.opr = '=';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr NE expr
		{
		Tmp1.opr = '!';
		Tmp2.opr = '=';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, OPERATOR, $1, $3));
		}|
	string GT string
		{
		Tmp1.opr = '>';
		$$ = node (&Tmp1, STRINGOP, $1, $3);
		}|
	string GE string
		{
		Tmp1.opr = '!';
		Tmp2.opr = '<';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, STRINGOP, $1, $3));
		}|
	expr GT expr
		{
		Tmp1.opr = '>';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr GE expr
		{
		Tmp1.opr = '!';
		Tmp2.opr = '<';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, OPERATOR, $1, $3));
		}|
	string LT string
		{
		Tmp1.opr = '<';
		$$ = node (&Tmp1, STRINGOP, $1, $3);
		}|
	string LE string
		{
		Tmp1.opr = '!';
		Tmp2.opr = '>';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, STRINGOP, $1, $3));
		}|
	expr LT expr
		{
		Tmp1.opr = '<';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr LE expr
		{
		Tmp1.opr = '!';
		Tmp2.opr = '>';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, OPERATOR, $1, $3));
		}|
	expr '&' expr
		{
		Tmp1.opr = '&';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr NAND expr
		{
		Tmp1.opr = '!';
		Tmp2.opr = '&';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, OPERATOR, $1, $3));
		}|
	expr '|' expr
		{
		Tmp1.opr = '|';
		$$ = node (&Tmp1, OPERATOR, $1, $3);
		}|
	expr NOR expr
		{
		Tmp1.opr = '!';
		Tmp2.opr = '|';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, OPERATOR, $1, $3));
		}|
	'-' expr %prec UMINUS
		{
		Tmp1.opr = '_';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'!' expr
		{
		Tmp1.opr = '!';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'l' expr
		{
		Tmp1.opr = 'l';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'L' expr
		{
		Tmp1.opr = 'L';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'e' expr
		{
		Tmp1.opr = 'e';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'a' expr
		{
		Tmp1.opr = 'a';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'f' expr
		{
		Tmp1.opr = 'f';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'c' expr
		{
		Tmp1.opr = 'c';
		$$ = node (&Tmp1, OPERATOR, ENULL, $2);
		}|
	'#' string
		{
		Tmp1.opr = '#';
		$$ = node (&Tmp1, STRINGOP, ENULL, $2);
		}|
	string '[' expr ']'
		{
		Tmp1.opr = '[';
		$$ = node (&Tmp1, STRINGOP, $1, $3);
		}|
	string 'C' string
		{
		Tmp1.opr = 'C';
		$$ = node (&Tmp1, STRINGOP, $1, $3);
		}|
	string NOTIN string
		{
		Tmp1.opr = '!';
		Tmp2.opr = 'C';
		$$ = node (&Tmp1, OPERATOR, ENULL,
			node (&Tmp2, STRINGOP, $1, $3));
		}|
	expr '?' stringexpr ':' stringexpr
		{
		Tmp1.opr = '?';
		Tmp2.opr = ':';
		$$ = node (&Tmp1, OPERATOR, $1,
			node (&Tmp2, OPERATOR,  $3, $5));
		}|
	IF expr THEN stringexpr ELSE stringexpr 
		{
		Tmp1.opr = '?';
		Tmp2.opr = ':';
		$$ = node (&Tmp1, OPERATOR, $2,
			node (&Tmp2, OPERATOR, $4, $6));
		}|
	NUMBER
		{
		Tmp1.num = $1;
		$$ = node (&Tmp1, FLOATPTR, ENULL, ENULL);
		};
string :
	STRING
		{
		Tmp1.str = $1;
		$$ = node (&Tmp1, STRINGPTR, ENULL, ENULL);
		};
%%

/*
Next is the scanner that will be repeatedly called by yyparse, yylex.
This simple program reads from a global char *Expra, set by main.  Variables
are handled by returning NUMBER or STRING, tokens defined in above grammar.
*/
#define	CONST	(*Expra=='.'||(*Expra>='0'&&*Expra<='9'))
yylex ()
	{
	extern	YYSTYPE yylval;
	char	*strsave ();
	int 	column;
	while (isspace (*Expra)) Expra++;
	if (CONST)
		{
		if (Nconst == MAXCONST)
			ERRMSG1 (Maximum number of constants is %d, MAXCONST)
		Const[Nconst] = atof (Expra);
		yylval.num = &Const[Nconst++];
		while (CONST) Expra++;
		return (NUMBER);
		}
	switch (*Expra)
		{
		case '"':
		case '\'':
			yylval.str = strsave ();
			return (STRING);
		case 's':
			column = atoi (++Expra);
			if (column > Usecols) Usecols = column;
			yylval.str = Str[column];
			while (CONST) Expra++;
			return (STRING);
		case 'x':
			if (Expra[1] == '[')
				{
				Expra++;
				return ('x');
				}
			column = atoi (++Expra);
			if (column > Usecols) Usecols = column;
			Usenumber[column] = TRUE;
			yylval.num = &Input[column];
			while (CONST) Expra++;
			return (NUMBER);
		case 'y':
			if (Expra[1] == '[')
				{
				Expra++;
				return ('y');
				}
			column = atoi (++Expra);
			if (column > Usecols) Usecols = column;
			yylval.num = &Output[column];
			while (CONST) Expra++;
			return (NUMBER);
		case 'K':
			if (begins (N_KILL, Expra))
				Expra += strlen (N_KILL);
			else Expra++;
			yylval.num = &Suppress;
			return (NUMBER);
		case 'E':
			if (begins (N_EXIT, Expra))
				Expra += strlen (N_EXIT);
			else Expra++;
			yylval.num = &Exitflag;
			return (NUMBER);
		case 'N':
			if (begins (N_NIL, Expra))
				{
				Expra += strlen (N_NIL);
				yylval.num = &Nil;
				}
			else if (begins ("NEXT", Expra))
				{
				Expra += 4;
				yylval.num = &Suppress;
				}
			else
				{
				Expra++;
				yylval.num = &N;
				}
			return (NUMBER);
		case 'S':
			if (begins ("SKIP", Expra))
				{
				Expra += 4;
				yylval.num = &Suppress;
				}
			else
				{
				if (begins (N_SUM, Expra))
					Expra += strlen (N_SUM);
				else Expra++;
				yylval.num = &Sum;
				}
			return (NUMBER);
		case 'R':
			if (begins (N_RAND, Expra)) Expra += strlen (N_RAND); else Expra++;
			Userand = TRUE;
			yylval.num = &Randu;
			return (NUMBER);
		case 'I':
			if (begins (N_INLINE, Expra))
				{
				Expra += strlen (N_INLINE);
				yylval.num = &INLINE;
				return (NUMBER);
				}
			if (begins (N_INPUT, Expra))
				Expra += strlen (N_INPUT);
			else Expra++;
			yylval.str = Inputline;
			return (STRING);
		case 'O':
			if (begins (N_OUTLINE, Expra))
				{
				Expra += strlen (N_OUTLINE);
				yylval.num = &OUTLINE;
				return (NUMBER);
				}
			break;
		case '=': if (Expra[1] == '=') Expra += 2;
			else Expra++;
			return (EQ);
		case '<': if (Expra[1] == '=')
			{
			Expra += 2;
			return (LE);
			}
			Expra++;
			return (LT);
		case '>': if (Expra[1] == '=')
			{
			Expra += 2;
			return (GE);
			}
			Expra++;
			return (GT);
		case '!': switch (Expra[1])
				{
				case '=': Expra += 2; return (NE);
				case 'C': Expra += 2; return (NOTIN);
				case '&': Expra += 2; return (NAND);
				case '|': Expra += 2; return (NOR);
				default: Expra++; return ('!');
				}
		case '&': if (Expra[1] == '&') Expra++; break;
		case '|': if (Expra[1] == '|') Expra++; break;
		case 'i': if (begins ("if", Expra))
				{Expra += 2; return (IF);} break;
		case 't': if (begins ("then", Expra))
				{Expra += 4; return (THEN);} break;
		case 'e': if (begins ("else", Expra))
				{Expra += 4; return (ELSE);}
			else if (begins (N_EXP, Expra))
				{Expra += strlen (N_EXP); return ('e');}
			break;
		case 'a': if (begins (N_ABS, Expra))
				{Expra += strlen (N_ABS); return ('a');}
			break;
		case 'f': if (begins (N_FLOOR, Expra))
				{Expra += strlen (N_FLOOR); return ('f');}
			break;
		case 'c': if (begins (N_CEIL, Expra))
				{Expra += strlen (N_CEIL); return ('c');}
			break;
		case 'l': if (begins (N_LOG, Expra))
				{Expra += strlen (N_LOG); return ('l');}
			break;
		case 'L': if (begins (N_LOG10, Expra))
				{Expra += strlen (N_LOG10); return ('L');}
			break;
		}
	return ((int) *Expra++);
	}

yyerror (msg)
char	*msg;
	{
	if (msg && *msg) fprintf (stderr, "\007dm: %s\n", msg);
	fprintf (stderr,
		"\007dm: Failure occured with this left in input: (%s)\n", Expra-1);
#ifdef PTREE
	ptree (Expr[Exprno]);
	putchar ('\n');
#endif
	}

char *
strsave ()
	{
	char	buf[BUFSIZ], *bptr = buf;
	char	*p;
	char	quotechar = *Expra++;
	while (*Expra && *Expra != quotechar)
		*bptr++ = *Expra++;
	if (*Expra == quotechar) Expra++;
	*bptr = '\0';
	if ((p = malloc ((unsigned) strlen (buf) + 1) ) == NULL)
		ERRSPACE (saving strings)
	return (strcpy (p, buf));
	}

ENODE *
node (datum, dtype, lson, rson)
STUFF	*datum;                /* string, number, or operator */
int 	dtype;                 /* STRINGPTR, FLOATPTR, OPERATOR, STRINGOP */
ENODE	*lson;
ENODE	*rson;
	{
	ENODE	*newnode;
	newnode = (ENODE *) malloc (sizeof (ENODE));
	if (newnode == NULL)
		ERRSPACE(expressions)
	newnode->etype = dtype;
	switch (dtype)
		{
		case FLOATPTR: newnode->contents.num = datum->num; break;
		case STRINGPTR: newnode->contents.str = datum->str; break;
		case STRINGOP:
		case OPERATOR: newnode->contents.opr = datum->opr; break;
		default: fprintf (stderr, "\007dm/enode: unknown data type.\n");
		}
	newnode->lchild = lson;
	newnode->rchild = rson;
	return (newnode);
	}

main (argc, argv) int argc; char *argv[];
	{
	ARGV0;
	initial (argc, argv);
	loop ();
	exit (0);
	}

/*
	initial does the following:
		1) inits the random number generator
		2) reads in expressions from file, user, or argv[i].
		3) parses expressions.
		4) opens input and output files.
*/
initial (argc, argv) int argc; char **argv;
	{
	lgl 	interactive = FALSE;    /* if true, input in interactive mode */
	lgl 	input_by_hand = FALSE;  /* true if expressions input by hand */
	char	exprline[BUFSIZ];       /* expressions read into here */
	FILE	*exprfile;              /* expressions read from here */
	FILE	*getfile ();            /* gets a file open */
	argc--;
	if (argc) checkstdin (Argv0);
	if (argc == 0)
		{
		interactive = TRUE;
		exprfile = getfile ("Expression file? ", "r");
		if (exprfile == NULL)
			{
			input_by_hand = TRUE;
			exprfile = stdin;
			printf ("Enter ONE expression per line.\n");
			printf ("End with an empty line.\n");
			}
		}
	else if (argv[1][0] == 'E') /*Expra file flag */
		{
		if ((exprfile = fopen (&argv[1][1], "r")) == NULL)
			ERROPEN (&argv[1][1])
		}
	else exprfile = NULL;
	for (;;) /* PARSE expressions until done */
		{
	readexpr:
		if (exprfile == NULL) /*read expras from argv[i] */
			{
			if (++Exprno > argc) break;
			Expra = argv[Exprno];
			}
		else /*read Expras from exprfile */
			{
			++Exprno;
			if (input_by_hand) printf ("expression[%d]: ", Exprno);
			if (getline (exprline, BUFSIZ, exprfile) <= 0) break;
			Expra = exprline;
			}

		while (isspace (*Expra)) Expra++;
		if (*Expra == 'X')
			{
			Should_output[Exprno] = FALSE;
			Expra++;
			}
		else Should_output[Exprno] = TRUE;
		if (yyparse() == PARSERROR) /* call parser */
			{
			fprintf (stderr, "\007dm: error in parsing expr[%d].\n",
				Exprno--);
			if (input_by_hand) goto readexpr; else exit (1);
			}
#ifdef PTREE
		if (interactive)
			{
			printf ("e%d: ", Exprno);
			ptree (Expr[Exprno]);
			putchar ('\n');
			}
#endif
		}
		Nexpr = Exprno - 1;
		if (Nexpr == 0)
			{
			Exprno = 0;
			fprintf (stderr, "dm: \007No expressions were read in\n");
			if (input_by_hand) goto readexpr;
			else exit (1);
			}
		/* OPEN I/O files */
		if (interactive)
			{
			if ((Infile = getfile ("Input file? ", "r")) == NULL)
				Infile = stdin;
			if ((Outfile = getfile ("Output file or pipe? ", "w")) == NULL)
				Outfile = stdout;
			}
		else
			{
			Infile = stdin;
			Outfile = stdout;
			}
	if (Userand) initrand ();
	}


/*	loop runs the process on the input to produce the output */
loop ()
	{
	double	eval ();
	lgl 	skip = FALSE;

	while (getinput () != EOF)
		{
		skip = FALSE;
		for (Exprno = 1; Exprno <= Nexpr; Exprno++)
			if ((Output[Exprno] = eval(Expr[Exprno])) == Suppress)
				{skip = TRUE; break;}
			else if (Output[Exprno] == Exitflag) exit (0);
		if (skip == TRUE) continue;
		OUTLINE += 1.0;
		for (Exprno = 1; Exprno <= Nexpr; Exprno++)
			if (Should_output[Exprno])
				{
				if (Output[Exprno] == Stringflag)
				fprintf (Outfile, "%s",Evalstr[Exprno]);
				else if (Output[Exprno] == Nil) continue;
				else fprintf (Outfile,"%.6g",Output[Exprno]);
				if (Exprno < Nexpr) putc ('\t', Outfile);
				}
		putc ('\n', Outfile);
		/* fflush (Outfile);  why was this needed? */
		}
#ifndef MSDOS /* no popen on MSDOS */
	if (Outpipe) VOID pclose (Outfile);
#endif
	}

int
getinput ()
	{
	int ncols;
	register int col;

	if (getline (Inputline, BUFSIZ, Infile) == EOF) return (EOF);
	if (Userand) Randu = rand()/Maxrand;
	Sum = 0.0;
	INLINE += 1.0;
	for (col = 1; col <= Usecols; col++)
		Str[col][0] = '\0';
	ncols = sstrings (Inputline, Str[1], MAXCOL, MAXSTRING);
	for (col = 1; col <= ncols; col++)
		if (number (Str[col]))
			Sum += Input[col] = atof(Str[col]);
		else
		if (Usenumber[col])
			ERRMSG2 (number expected in column %d on line %.0f, col, INLINE)
	N = ncols;
	return (ncols);
	}


/*
eval is a recursive function that takes a parse tree of an expression,
and returns its value.  The major kluge in this program is how it handles
strings.  Since it wants to return a double, it cannot return a string, so
the use of strings is somewhat restricted.  When eval evals to a string, it
returns STRINGFLAG after setting a global char *Evalstr[Exprno] to the str
MAIN will look for this flag and switch its output to Evalstr[Exprno] rather
than Output[Exprno].
*/
double
eval (expression) ENODE *expression;
	{
	int 	comp;                 /*for string comparisons*/
	int 	sindex, character;    /*for STRINDEX function */
	char	*string_2b_indexed;   /*for STRINDEX function */
	double	tmp1, tmp2;
	char	operator;
	if (expression == NULL) return (0.0);
	if (expression->etype == FLOATPTR)
		return (*expression->contents.num);
	if (expression->etype == STRINGPTR) 
		{
		Evalstr[Exprno] = expression->contents.str;
		return (Stringflag);
		}
	if (expression->etype == STRINGOP)
		{
		switch (expression->contents.opr)
			{
			case '=': /*string compare*/
				comp = strcmp (expression->lchild->contents.str,
					expression->rchild->contents.str);
				return (comp ? 0.0 : 1.0);
			case '>': /*string compare*/
				comp = strcmp (expression->lchild->contents.str,
					expression->rchild->contents.str);
				return (comp > 0 ? 1.0 : 0.0);
			case '<': /*string compare*/
				comp = strcmp (expression->lchild->contents.str,
					expression->rchild->contents.str);
				return (comp < 0 ? 1.0 : 0.0);
			case 'C': /*true is s1 is in s2 */
				comp = substr (expression->lchild->contents.str,
					expression->rchild->contents.str);
				return (comp ? 1.0 : 0.0);
			case '#':
				return ((double) strlen (expression->rchild->contents.str));
			case '[': /* string index */
				sindex = eval (expression->rchild);
				string_2b_indexed = expression->lchild->contents.str;
				character = string_2b_indexed[sindex-1];
				return (1.0 * character);
			}
		}
	operator = expression->contents.opr;
	if (operator == ':') return (0.0); /*dummy for conditional */
	tmp1 = eval (expression->lchild);
	tmp2 = eval (expression->rchild);
	switch (operator)
	{
	case 'x':
		sindex = (int) tmp2;
		if (sindex < 0 || sindex > N)
			ERRMSG1 (computed index for x (%d) is out of range, sindex)
		if (Usenumber[sindex]) return (Input[sindex]);
		if (number (Str[sindex])) return (atof (Str[sindex]));
			ERRMSG2 (number expected in column %d of line %.0f, sindex, INLINE)
	case 'y':
		sindex = (int) tmp2;
		if (sindex >= 0 && sindex <= Nexpr)
		return (Output[sindex]);
		ERRMSG1 (computed index for y (%d) is  out of range, sindex)
	case '_': return (-tmp2);
	case '!': return (fzero (tmp2) ? 1.0 : 0.0);
	case 'l': if (tmp2 <= 0.0)
		ERRMSG3 (log undefined for %f on line %.0f  expr[%d], tmp2, INLINE,Exprno)
		return (log (tmp2));
	case 'L': if (tmp2 <= 0.0)
		ERRMSG3(Log undefined for %f Input line %.0f  expr[%d], tmp2,INLINE,Exprno)
		return (log (tmp2) / LOGe10);
	case 'e': return (exp (tmp2));
	case 'a': return (fabs (tmp2));
	case 'c': return (ceil (tmp2));
	case 'f': return (floor (tmp2));
	case '+': return (tmp1 + tmp2);
	case '-': return (tmp1 - tmp2);
	case '*': return (tmp1 * tmp2);
	case '%': if (fzero (tmp2))
		ERRMSG2 (division by zero. input line %.0f  expr[%d], INLINE,Exprno)
		return ((double) (((int) tmp1) % ((int) tmp2)));
	case '/': if (fzero (tmp2))
		ERRMSG2 (division by zero. input line %.0f  expr[%d], INLINE,Exprno)
		return (tmp1/tmp2);
	case '^':
		if (tmp1 < 0.0 && (floor (tmp2) != tmp2))
			ERRMSG1 (power failure at line %.0f, INLINE)
		return (pow (tmp1, tmp2));
	case '>': return (tmp1 > tmp2 ? 1.0 : 0.0);
	case '<': return (tmp1 < tmp2 ? 1.0 : 0.0);
	case '=': return (fzero (tmp1 - tmp2) ? 1.0 : 0.0);
	case '&': return ((!fzero (tmp1) && !fzero (tmp2)) ? 1.0 : 0.0);
	case '|': return ((!fzero (tmp1) || !fzero (tmp2)) ? 1.0 : 0.0);
	case '?': if (!fzero (tmp1))
		return (eval (expression->rchild->lchild));
		return (eval (expression->rchild->rchild));
	default:
		ERRMSG1 (Unknown operator '%c', operator)
	}
	return (Exitflag);
	}

#ifdef PTREE
ptree (tree) ENODE *tree;
	{
	if (tree == NULL) return;
	if (tree->etype == FLOATPTR)
		if (*tree->contents.num < -LARGE)
			{
			double	*nptr = tree->contents.num;
			if (nptr == &Suppress)
				printf (N_KILL);
			else if (nptr == &Exitflag)
				printf (N_EXIT);
			else if (nptr == &Nil)
				printf (N_NIL);
			else printf ("CONTROL");
			}
		else /* regular number */
			{
			double	*dptr = tree->contents.num;
			if (dptr > Input && dptr <= &Input[MAXCOL])
				printf ("x%d", dptr - Input);
			else if (dptr == &INLINE)
				printf (N_INLINE);
			else if (dptr > Output && dptr <= &Output[MAXCOL])
				printf ("y%d", dptr - Output);
			else if (dptr == &OUTLINE)
				printf (N_OUTLINE);
			else if (dptr == &N)
				printf (N_N);
			else if (dptr == &Sum)
				printf (N_SUM);
			else if (dptr == &Randu)
				printf (N_RAND);
			else	printf ("%g", *dptr);
			}
	else if (tree->etype == STRINGPTR)
		{
		char	*sptr = tree->contents.str;
		if (sptr == Inputline)
			printf (N_INPUT);
		else if (sptr >= Str[0] && sptr < Str[MAXCOL])
			printf ("s%d", (sptr - Str[0])/MAXSTRING);
		else printf ("'%s'", sptr);
		}
	else if (tree->etype == OPERATOR || tree->etype == STRINGOP)
		{
		int 	op = tree->contents.opr;
		printf ("(");
		ptree (tree->lchild);
		switch (op)
			{
			case 'l': printf ("%s ", N_LOG); break;
			case 'L': printf ("%s ", N_LOG10); break;
			case 'e': printf ("%s ", N_EXP); break;
			case 'c': printf ("%s ", N_CEIL); break;
			case 'f': printf ("%s ", N_FLOOR); break;
			case 'a': printf ("%s ", N_ABS); break;
			default:
				printf (" %c ", op);
			}
		ptree (tree->rchild);
		printf (")");
		}
	else printf ("(bad node type %d)", tree->etype);
	}
#endif

FILE *
getfile (prompt, mode) char *prompt, *mode;
	{
#ifndef MSDOS /* no popen on MSDOS */
	FILE	*popen ();
#endif
	FILE	*fopen (), *ioptr;
	char	filename[BUFSIZ];
	char	*ptr = filename;
  newfile:
	printf ("%s", prompt);
	if (getline (filename, MAXSTRING, stdin) <= 0) return (NULL);
	while (isspace (*ptr)) ptr++;
	if (*ptr == NULL) return (NULL);
	if (*mode == 'w')
		if (*ptr == '|') Outpipe = 1;
		else if (!canwrite (filename)) goto newfile;
	if (Outpipe)
		{
#ifndef MSDOS /* no popen on MSDOS */
		if ((ioptr = popen (ptr+1, "w")) == NULL)
#endif
			{
			fprintf (stderr, "Cannot create pipe.\n");
			Outpipe = 0;
			goto newfile;
			}
		}
	else if ((ioptr = fopen (filename, mode)) == NULL)
		{
		printf ("Cannot open '%s'.\n", filename);
		goto newfile;
		}
	return (ioptr);
	}

int
getline (string, maxlen, ioptr)
char	*string;
int 	maxlen;
FILE	*ioptr;
	{
	register	int 	inchar;
	register	int 	len = 0;
	while ((inchar = getc (ioptr)) != EOF)
		{
		if (inchar == '\n') break;
		else if (inchar == '\\')
			if ((inchar = getc (ioptr)) == EOF) inchar = '\\';
		string[len] = inchar;
		if (++len == maxlen) break;
		}
	string[len] = '\0';
	if (len == 0 && feof (ioptr)) return (EOF);
	return (len);
	}


begins (s1, s2) char *s1, *s2;
	{
	while (*s1)
		if (*s1++ != *s2++) return (0);
	return (1);
	/* return (isalpha (*s2) ? 0 : 1);  can't be used because of s1 C s2 */
	}

substr (s1, s2) char *s1, *s2;
	{
	while (*s2)
		if (begins (s1, s2)) return (1);
		else s2++;
	return (0);
	}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦b962bf620⟧ TextFile

Derivation

TextFile
