[unix-history] / usr / src / usr.bin / bc / bc.y

%{
/*-
 * Copyright (c) 1991 The Regents of the University of California.
 * All rights reserved.
 *
 * %sccs.include.proprietary.c%
 */

#ifndef lint
char copyright[] =
"@(#) Copyright (c) 1991 The Regents of the University of California.\n\
 All rights reserved.\n";
#endif /* not lint */

#ifndef lint
static char sccsid[] = "@(#)bc.y	5.1 (Berkeley) %G%";
#endif /* not lint */

	int *getout();
%}
%right '='
%left '+' '-'
%left '*' '/' '%'
%right '^'
%left UMINUS

%term LETTER DIGIT SQRT LENGTH _IF  FFF EQ
%term _WHILE _FOR NE LE GE INCR DECR
%term _RETURN _BREAK _DEFINE BASE OBASE SCALE
%term EQPL EQMI EQMUL EQDIV EQREM EQEXP
%term _AUTO DOT
%term QSTR

%{
#include <sys/signal.h>
#include <stdio.h>
#include <varargs.h>
#include "pathnames.h"
FILE *in;
char cary[1000], *cp = { cary };
char string[1000], *str = {string};
int crs = '0';
int rcrs = '0';  /* reset crs */
int bindx = 0;
int lev = 0;
int ln;
char *ss;
int bstack[10] = { 0 };
char *numb[15] = {
  " 0", " 1", " 2", " 3", " 4", " 5",
  " 6", " 7", " 8", " 9", " 10", " 11",
  " 12", " 13", " 14" };
int *pre, *post;
%}
%%
start	: 
	|  start stat tail
		= output( $2 );
	|  start def dargs ')' '{' dlist slist '}'
		={	bundle( 6,pre, $7, post ,"0",numb[lev],"Q");
			conout( $$, $2 );
			rcrs = crs;
			output( "" );
			lev = bindx = 0;
			}
	;

dlist	:  tail
	| dlist _AUTO dlets tail
	;

stat	:  e 
		={ bundle(2, $1, "ps." ); }
	| 
		={ bundle(1, "" ); }
	|  QSTR
		={ bundle(3,"[",$1,"]P");}
	|  LETTER '=' e
		={ bundle(3, $3, "s", $1 ); }
	|  LETTER '[' e ']' '=' e
		={ bundle(4, $6, $3, ":", geta($1)); }
	|  LETTER EQOP e
		={ bundle(6, "l", $1, $3, $2, "s", $1 ); }
	|  LETTER '[' e ']' EQOP e
		={ bundle(8,$3, ";", geta($1), $6, $5, $3, ":", geta($1));}
	|  _BREAK
		={ bundle(2, numb[lev-bstack[bindx-1]], "Q" ); }
	|  _RETURN '(' e ')'
		= bundle(4, $3, post, numb[lev], "Q" );
	|  _RETURN '(' ')'
		= bundle(4, "0", post, numb[lev], "Q" );
	| _RETURN
		= bundle(4,"0",post,numb[lev],"Q");
	| SCALE '=' e
		= bundle(2, $3, "k");
	| SCALE EQOP e
		= bundle(4,"K",$3,$2,"k");
	| BASE '=' e
		= bundle(2,$3, "i");
	| BASE EQOP e
		= bundle(4,"I",$3,$2,"i");
	| OBASE '=' e
		= bundle(2,$3,"o");
	| OBASE EQOP e
		= bundle(4,"O",$3,$2,"o");
	|  '{' slist '}'
		={ $$ = $2; }
	|  FFF
		={ bundle(1,"fY"); }
	|  error
		={ bundle(1,"c"); }
	|  _IF CRS BLEV '(' re ')' stat
		={	conout( $7, $2 );
			bundle(3, $5, $2, " " );
			}
	|  _WHILE CRS '(' re ')' stat BLEV
		={	bundle(3, $6, $4, $2 );
			conout( $$, $2 );
			bundle(3, $4, $2, " " );
			}
	|  fprefix CRS re ';' e ')' stat BLEV
		={	bundle(5, $7, $5, "s.", $3, $2 );
			conout( $$, $2 );
			bundle(5, $1, "s.", $3, $2, " " );
			}
	|  '~' LETTER '=' e
		={	bundle(3,$4,"S",$2); }
	;

EQOP	:  EQPL
		={ $$ = "+"; }
	|  EQMI
		={ $$ = "-"; }
	|  EQMUL
		={ $$ = "*"; }
	|  EQDIV
		={ $$ = "/"; }
	|  EQREM
		={ $$ = "%%"; }
	|  EQEXP
		={ $$ = "^"; }
	;

fprefix	:  _FOR '(' e ';'
		={ $$ = $3; }
	;

BLEV	:
		={ --bindx; }
	;

slist	:  stat
	|  slist tail stat
		={ bundle(2, $1, $3 ); }
	;

tail	:  '\n'
		={ln++;}
	|  ';'
	;

re	:  e EQ e
		= bundle(3, $1, $3, "=" );
	|  e '<' e
		= bundle(3, $1, $3, ">" );
	|  e '>' e
		= bundle(3, $1, $3, "<" );
	|  e NE e
		= bundle(3, $1, $3, "!=" );
	|  e GE e
		= bundle(3, $1, $3, "!>" );
	|  e LE e
		= bundle(3, $1, $3, "!<" );
	|  e
		= bundle(2, $1, " 0!=" );
	;

e	:  e '+' e
		= bundle(3, $1, $3, "+" );
	|  e '-' e
		= bundle(3, $1, $3, "-" );
	| '-' e		%prec UMINUS
		= bundle(3, " 0", $2, "-" );
	|  e '*' e
		= bundle(3, $1, $3, "*" );
	|  e '/' e
		= bundle(3, $1, $3, "/" );
	|  e '%' e
		= bundle(3, $1, $3, "%%" );
	|  e '^' e
		= bundle(3, $1, $3, "^" );
	|  LETTER '[' e ']'
		={ bundle(3,$3, ";", geta($1)); }
	|  LETTER INCR
		= bundle(4, "l", $1, "d1+s", $1 );
	|  INCR LETTER
		= bundle(4, "l", $2, "1+ds", $2 );
	|  DECR LETTER
		= bundle(4, "l", $2, "1-ds", $2 );
	|  LETTER DECR
		= bundle(4, "l", $1, "d1-s", $1 );
	| LETTER '[' e ']' INCR
		= bundle(7,$3,";",geta($1),"d1+",$3,":",geta($1));
	| INCR LETTER '[' e ']'
		= bundle(7,$4,";",geta($2),"1+d",$4,":",geta($2));
	| LETTER '[' e ']' DECR
		= bundle(7,$3,";",geta($1),"d1-",$3,":",geta($1));
	| DECR LETTER '[' e ']'
		= bundle(7,$4,";",geta($2),"1-d",$4,":",geta($2));
	| SCALE INCR
		= bundle(1,"Kd1+k");
	| INCR SCALE
		= bundle(1,"K1+dk");
	| SCALE DECR
		= bundle(1,"Kd1-k");
	| DECR SCALE
		= bundle(1,"K1-dk");
	| BASE INCR
		= bundle(1,"Id1+i");
	| INCR BASE
		= bundle(1,"I1+di");
	| BASE DECR
		= bundle(1,"Id1-i");
	| DECR BASE
		= bundle(1,"I1-di");
	| OBASE INCR
		= bundle(1,"Od1+o");
	| INCR OBASE
		= bundle(1,"O1+do");
	| OBASE DECR
		= bundle(1,"Od1-o");
	| DECR OBASE
		= bundle(1,"O1-do");
	|  LETTER '(' cargs ')'
		= bundle(4, $3, "l", getf($1), "x" );
	|  LETTER '(' ')'
		= bundle(3, "l", getf($1), "x" );
	|  cons
		={ bundle(2, " ", $1 ); }
	|  DOT cons
		={ bundle(2, " .", $2 ); }
	|  cons DOT cons
		={ bundle(4, " ", $1, ".", $3 ); }
	|  cons DOT
		={ bundle(3, " ", $1, "." ); }
	|  DOT
		={ $$ = "l."; }
	|  LETTER
		= { bundle(2, "l", $1 ); }
	|  LETTER '=' e
		={ bundle(3, $3, "ds", $1 ); }
	|  LETTER EQOP e	%prec '='
		={ bundle(6, "l", $1, $3, $2, "ds", $1 ); }
	| LETTER '[' e ']' '=' e
		= { bundle(5,$6,"d",$3,":",geta($1)); }
	| LETTER '[' e ']' EQOP e
		= { bundle(9,$3,";",geta($1),$6,$5,"d",$3,":",geta($1)); }
	| LENGTH '(' e ')'
		= bundle(2,$3,"Z");
	| SCALE '(' e ')'
		= bundle(2,$3,"X");	/* must be before '(' e ')' */
	|  '(' e ')'
		= { $$ = $2; }
	|  '?'
		={ bundle(1, "?" ); }
	|  SQRT '(' e ')'
		={ bundle(2, $3, "v" ); }
	| '~' LETTER
		={ bundle(2,"L",$2); }
	| SCALE '=' e
		= bundle(2,$3,"dk");
	| SCALE EQOP e		%prec '='
		= bundle(4,"K",$3,$2,"dk");
	| BASE '=' e
		= bundle(2,$3,"di");
	| BASE EQOP e		%prec '='
		= bundle(4,"I",$3,$2,"di");
	| OBASE '=' e
		= bundle(2,$3,"do");
	| OBASE EQOP e		%prec '='
		= bundle(4,"O",$3,$2,"do");
	| SCALE
		= bundle(1,"K");
	| BASE
		= bundle(1,"I");
	| OBASE
		= bundle(1,"O");
	;

cargs	:  eora
	|  cargs ',' eora
		= bundle(2, $1, $3 );
	;
eora:	  e
	| LETTER '[' ']'
		=bundle(2,"l",geta($1));
	;

cons	:  constant
		={ *cp++ = '\0'; }

constant:
	  '_'
		={ $$ = cp; *cp++ = '_'; }
	|  DIGIT
		={ $$ = cp; *cp++ = $1; }
	|  constant DIGIT
		={ *cp++ = $2; }
	;

CRS	:
		={ $$ = cp; *cp++ = crs++; *cp++ = '\0';
			if(crs == '[')crs+=3;
			if(crs == 'a')crs='{';
			if(crs >= 0241){yyerror("program too big");
				getout();
			}
			bstack[bindx++] = lev++; }
	;

def	:  _DEFINE LETTER '('
		={	$$ = getf($2);
			pre = "";
			post = "";
			lev = 1;
			bstack[bindx=0] = 0;
			}
	;

dargs	:
	|  lora
		={ pp( $1 ); }
	|  dargs ',' lora
		={ pp( $3 ); }
	;

dlets	:  lora
		={ tp($1); }
	|  dlets ',' lora
		={ tp($3); }
	;
lora	:  LETTER
	|  LETTER '[' ']'
		={ $$ = geta($1); }
	;

%%
# define error 256

int peekc = -1;
int sargc;
int ifile;
char **sargv;

char funtab[52] = {
	01,0,02,0,03,0,04,0,05,0,06,0,07,0,010,0,011,0,012,0,013,0,014,0,015,0,016,0,017,0,
	020,0,021,0,022,0,023,0,024,0,025,0,026,0,027,0,030,0,031,0,032,0 };
char atab[52] = {
	0241,0,0242,0,0243,0,0244,0,0245,0,0246,0,0247,0,0250,0,0251,0,0252,0,0253,0,
	0254,0,0255,0,0256,0,0257,0,0260,0,0261,0,0262,0,0263,0,0264,0,0265,0,0266,0,
	0267,0,0270,0,0271,0,0272,0};
char *letr[26] = {
  "a","b","c","d","e","f","g","h","i","j",
  "k","l","m","n","o","p","q","r","s","t",
  "u","v","w","x","y","z" } ;
char *dot = { "." };
yylex(){
	int c, ch;
restart:
	c = getch();
	peekc = -1;
	while( c == ' ' || c == '\t' ) c = getch();
	if(c == '\\'){
		getch();
		goto restart;
	}
	if( c<= 'z' && c >= 'a' ) {
		/* look ahead to look for reserved words */
		peekc = getch();
		if( peekc >= 'a' && peekc <= 'z' ){ /* must be reserved word */
			if( c=='i' && peekc=='f' ){ c=_IF; goto skip; }
			if( c=='w' && peekc=='h' ){ c=_WHILE; goto skip; }
			if( c=='f' && peekc=='o' ){ c=_FOR; goto skip; }
			if( c=='s' && peekc=='q' ){ c=SQRT; goto skip; }
			if( c=='r' && peekc=='e' ){ c=_RETURN; goto skip; }
			if( c=='b' && peekc=='r' ){ c=_BREAK; goto skip; }
			if( c=='d' && peekc=='e' ){ c=_DEFINE; goto skip; }
			if( c=='s' && peekc=='c' ){ c= SCALE; goto skip; }
			if( c=='b' && peekc=='a' ){ c=BASE; goto skip; }
			if( c=='i' && peekc == 'b'){ c=BASE; goto skip; }
			if( c=='o' && peekc=='b' ){ c=OBASE; goto skip; }
			if( c=='d' && peekc=='i' ){ c=FFF; goto skip; }
			if( c=='a' && peekc=='u' ){ c=_AUTO; goto skip; }
			if( c == 'l' && peekc=='e'){ c=LENGTH; goto skip; }
			if( c == 'q' && peekc == 'u'){getout();}
			/* could not be found */
			return( error );
		skip:	/* skip over rest of word */
			peekc = -1;
			while( (ch = getch()) >= 'a' && ch <= 'z' );
			peekc = ch;
			return( c );
		}

		/* usual case; just one single letter */

		yylval = letr[c-'a'];
		return( LETTER );
	}
	if( c>= '0' && c <= '9' || c>= 'A' && c<= 'F' ){
		yylval = c;
		return( DIGIT );
	}
	switch( c ){
	case '.':	return( DOT );
	case '=':
		switch( peekc = getch() ){
		case '=': c=EQ; goto gotit;
		case '+': c=EQPL; goto gotit;
		case '-': c=EQMI; goto gotit;
		case '*': c=EQMUL; goto gotit;
		case '/': c=EQDIV; goto gotit;
		case '%': c=EQREM; goto gotit;
		case '^': c=EQEXP; goto gotit;
		default:   return( '=' );
			  gotit:     peekc = -1; return(c);
		  }
	case '+':	return( cpeek( '+', INCR, cpeek( '=', EQPL, '+') ) );
	case '-':	return( cpeek( '-', DECR, cpeek( '=', EQMI, '-') ) );
	case '<':	return( cpeek( '=', LE, '<' ) );
	case '>':	return( cpeek( '=', GE, '>' ) );
	case '!':	return( cpeek( '=', NE, '!' ) );
	case '/':
		if((peekc = getch()) == '*'){
			peekc = -1;
			while((getch() != '*') || ((peekc = getch()) != '/'));
			peekc = -1;
			goto restart;
		}
		else if (peekc == '=') {
			c=EQDIV;
			goto gotit;
		}
		else return(c);
	case '*':
		return( cpeek( '=', EQMUL, '*' ) );
	case '%':
		return( cpeek( '=', EQREM, '%' ) );
	case '^':
		return( cpeek( '=', EQEXP, '^' ) );
	case '"':	
		 yylval = str;
		 while((c=getch()) != '"'){*str++ = c;
			if(str >= &string[999]){yyerror("string space exceeded");
			getout();
		}
	}
	 *str++ = '\0';
	return(QSTR);
	default:	 return( c );
	}
}

cpeek( c, yes, no ){
	if( (peekc=getch()) != c ) return( no );
	else {
		peekc = -1;
		return( yes );
	}
}

getch(){
	int ch;
loop:
	ch = (peekc < 0) ? getc(in) : peekc;
	peekc = -1;
	if(ch != EOF)return(ch);
	if(++ifile > sargc){
		if(ifile >= sargc+2)getout();
		in = stdin;
		ln = 0;
		goto loop;
	}
	fclose(in);
	if((in = fopen(sargv[ifile],"r")) != NULL){
		ln = 0;
		ss = sargv[ifile];
		goto loop;
	}
	yyerror("cannot open input file");
}
# define b_sp_max 3000
int b_space [ b_sp_max ];
int * b_sp_nxt = { b_space };

int bdebug = 0;
/*VARARGS*/
bundle(va_alist) va_dcl {
	va_list ap;
	int i, *q;

	va_start(ap);
	i = va_arg(ap, int);
	q = b_sp_nxt;
	if( bdebug ) printf("bundle %d elements at %o\n",i,  q );
	while(i-- > 0){
		if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" );
		* b_sp_nxt++ = va_arg(ap, int);
	}
	* b_sp_nxt++ = 0;
	yyval = q;
	va_end(ap);
	return( q );
}

routput(p) int *p; {
	if( bdebug ) printf("routput(%o)\n", p );
	if( p >= &b_space[0] && p < &b_space[b_sp_max]){
		/* part of a bundle */
		while( *p != 0 ) routput( *p++ );
	}
	else printf( p );	 /* character string */
}

output( p ) int *p; {
	routput( p );
	b_sp_nxt = & b_space[0];
	printf( "\n" );
	fflush(stdout);
	cp = cary;
	crs = rcrs;
}

conout( p, s ) int *p; char *s; {
	printf("[");
	routput( p );
	printf("]s%s\n", s );
	fflush(stdout);
	lev--;
}

yyerror( s ) char *s; {
	if(ifile > sargc)ss="teletype";
	printf("c[%s on line %d, %s]pc\n", s ,ln+1,ss);
	fflush(stdout);
	cp = cary;
	crs = rcrs;
	bindx = 0;
	lev = 0;
	b_sp_nxt = &b_space[0];
}

pp( s ) char *s; {
	/* puts the relevant stuff on pre and post for the letter s */

	bundle(3, "S", s, pre );
	pre = yyval;
	bundle(4, post, "L", s, "s." );
	post = yyval;
}

tp( s ) char *s; { /* same as pp, but for temps */
	bundle(3, "0S", s, pre );
	pre = yyval;
	bundle(4, post, "L", s, "s." );
	post = yyval;
}

yyinit(argc,argv) int argc; char *argv[];{
	(void)signal(SIGINT, SIG_IGN);	/* ignore all interrupts */
	sargv=argv;
	sargc= -- argc;
	if(sargc == 0)in=stdin;
	else if((in = fopen(sargv[1],"r")) == NULL) {
		yyerror("cannot open input file");
		in = stdin;
	}
	ifile = 1;
	ln = 0;
	ss = sargv[1];
}
int *getout(){
	printf("q");
	fflush(stdout);
	exit(0);
}

int *
getf(p) char *p;{
	return(&funtab[2*(*p -0141)]);
}
int *
geta(p) char *p;{
	return(&atab[2*(*p - 0141)]);
}

main(argc, argv)
char **argv;
{
	int p[2];


	if (argc > 1 && *argv[1] == '-') {
		if((argv[1][1] == 'd')||(argv[1][1] == 'c')){
			yyinit(--argc, ++argv);
			yyparse();
			exit(0);
		}
		if(argv[1][1] != 'l'){
			printf("unrecognizable argument\n");
			fflush(stdout);
			exit(1);
		}
		argv[1] = _PATH_LIBB;
	}
	pipe(p);
	if (fork()==0) {
		close(1);
		dup(p[1]);
		close(p[0]);
		close(p[1]);
		yyinit(argc, argv);
		yyparse();
		exit(0);
	}
	close(0);
	dup(p[0]);
	close(p[0]);
	close(p[1]);
	execl(_PATH_DC, "dc", "-", (char *)0);
	perror("bc: can't find dc");
	exit(1);
}
Commit	Line	Data
a27f2922	1	%{
2791ff57 KB	2	/*-
	3	* Copyright (c) 1991 The Regents of the University of California.
	4	* All rights reserved.
	5	*
	6	* %sccs.include.proprietary.c%
	7	*/
	8
	9	#ifndef lint
	10	char copyright[] =
	11	"@(#) Copyright (c) 1991 The Regents of the University of California.\n\
	12	All rights reserved.\n";
	13	#endif /* not lint */
	14
	15	#ifndef lint
	16	static char sccsid[] = "@(#)bc.y 5.1 (Berkeley) %G%";
	17	#endif /* not lint */
	18
a27f2922 BJ	19	int *getout();
	20	%}
	21	%right '='
	22	%left '+' '-'
	23	%left '*' '/' '%'
	24	%right '^'
	25	%left UMINUS
	26
	27	%term LETTER DIGIT SQRT LENGTH _IF FFF EQ
	28	%term _WHILE _FOR NE LE GE INCR DECR
	29	%term _RETURN _BREAK _DEFINE BASE OBASE SCALE
	30	%term EQPL EQMI EQMUL EQDIV EQREM EQEXP
	31	%term _AUTO DOT
	32	%term QSTR
	33
	34	%{
392fe950	35	#include <sys/signal.h>
a27f2922	36	#include <stdio.h>
6d987ad7	37	#include <varargs.h>
0092fa3d	38	#include "pathnames.h"
4e44ae42	39	FILE *in;
a27f2922 BJ	40	char cary[1000], *cp = { cary };
	41	char string[1000], *str = {string};
	42	int crs = '0';
	43	int rcrs = '0'; /* reset crs */
	44	int bindx = 0;
	45	int lev = 0;
	46	int ln;
	47	char *ss;
	48	int bstack[10] = { 0 };
	49	char *numb[15] = {
	50	" 0", " 1", " 2", " 3", " 4", " 5",
	51	" 6", " 7", " 8", " 9", " 10", " 11",
	52	" 12", " 13", " 14" };
	53	int pre, post;
	54	%}
	55	%%
	56	start :
	57	\| start stat tail
	58	= output( $2 );
	59	\| start def dargs ')' '{' dlist slist '}'
	60	={ bundle( 6,pre, $7, post ,"0",numb[lev],"Q");
	61	conout( $$, $2 );
	62	rcrs = crs;
	63	output( "" );
	64	lev = bindx = 0;
	65	}
	66	;
	67
	68	dlist : tail
	69	\| dlist _AUTO dlets tail
	70	;
	71
	72	stat : e
	73	={ bundle(2, $1, "ps." ); }
	74	\|
	75	={ bundle(1, "" ); }
	76	\| QSTR
	77	={ bundle(3,"[",$1,"]P");}
	78	\| LETTER '=' e
	79	={ bundle(3, $3, "s", $1 ); }
	80	\| LETTER '[' e ']' '=' e
	81	={ bundle(4, $6, $3, ":", geta($1)); }
	82	\| LETTER EQOP e
	83	={ bundle(6, "l", $1, $3, $2, "s", $1 ); }
	84	\| LETTER '[' e ']' EQOP e
	85	={ bundle(8,$3, ";", geta($1), $6, $5, $3, ":", geta($1));}
	86	\| _BREAK
	87	={ bundle(2, numb[lev-bstack[bindx-1]], "Q" ); }
	88	\| _RETURN '(' e ')'
	89	= bundle(4, $3, post, numb[lev], "Q" );
	90	\| _RETURN '(' ')'
	91	= bundle(4, "0", post, numb[lev], "Q" );
	92	\| _RETURN
	93	= bundle(4,"0",post,numb[lev],"Q");
	94	\| SCALE '=' e
	95	= bundle(2, $3, "k");
	96	\| SCALE EQOP e
	97	= bundle(4,"K",$3,$2,"k");
	98	\| BASE '=' e
	99	= bundle(2,$3, "i");
	100	\| BASE EQOP e
	101	= bundle(4,"I",$3,$2,"i");
	102	\| OBASE '=' e
	103	= bundle(2,$3,"o");
104	\| OBASE EQOP e
105	= bundle(4,"O",$3,$2,"o");
106	\| '{' slist '}'
107	={ $$ = $2; }
108	\| FFF
109	={ bundle(1,"fY"); }
110	\| error
111	={ bundle(1,"c"); }
112	\| _IF CRS BLEV '(' re ')' stat
113	={ conout( $7, $2 );
114	bundle(3, $5, $2, " " );
115	}
116	\| _WHILE CRS '(' re ')' stat BLEV
117	={ bundle(3, $6, $4, $2 );
118	conout( $$, $2 );
119	bundle(3, $4, $2, " " );
120	}
121	\| fprefix CRS re ';' e ')' stat BLEV
122	={ bundle(5, $7, $5, "s.", $3, $2 );
123	conout( $$, $2 );
124	bundle(5, $1, "s.", $3, $2, " " );
125	}
126	\| '~' LETTER '=' e
127	={ bundle(3,$4,"S",$2); }
128	;
129
130	EQOP : EQPL
131	={ $$ = "+"; }
132	\| EQMI
133	={ $$ = "-"; }
134	\| EQMUL
135	={ $$ = "*"; }
136	\| EQDIV
137	={ $$ = "/"; }
138	\| EQREM
139	={ $$ = "%%"; }
140	\| EQEXP
141	={ $$ = "^"; }
142	;
143
144	fprefix : _FOR '(' e ';'
145	={ $$ = $3; }
146	;
147
148	BLEV :
149	={ --bindx; }
150	;
151
152	slist : stat
153	\| slist tail stat
154	={ bundle(2, $1, $3 ); }
155	;
156
157	tail : '\n'
158	={ln++;}
159	\| ';'
160	;
161
162	re : e EQ e
163	= bundle(3, $1, $3, "=" );
164	\| e '<' e
165	= bundle(3, $1, $3, ">" );
166	\| e '>' e
167	= bundle(3, $1, $3, "<" );
168	\| e NE e
169	= bundle(3, $1, $3, "!=" );
170	\| e GE e
171	= bundle(3, $1, $3, "!>" );
172	\| e LE e
173	= bundle(3, $1, $3, "!<" );
174	\| e
175	= bundle(2, $1, " 0!=" );
176	;
177
178	e : e '+' e
179	= bundle(3, $1, $3, "+" );
180	\| e '-' e
181	= bundle(3, $1, $3, "-" );
182	\| '-' e %prec UMINUS
183	= bundle(3, " 0", $2, "-" );
184	\| e '*' e
185	= bundle(3, $1, $3, "*" );
186	\| e '/' e
187	= bundle(3, $1, $3, "/" );
188	\| e '%' e
189	= bundle(3, $1, $3, "%%" );
190	\| e '^' e
191	= bundle(3, $1, $3, "^" );
192	\| LETTER '[' e ']'
193	={ bundle(3,$3, ";", geta($1)); }
194	\| LETTER INCR
195	= bundle(4, "l", $1, "d1+s", $1 );
196	\| INCR LETTER
197	= bundle(4, "l", $2, "1+ds", $2 );
198	\| DECR LETTER
199	= bundle(4, "l", $2, "1-ds", $2 );
200	\| LETTER DECR
201	= bundle(4, "l", $1, "d1-s", $1 );
202	\| LETTER '[' e ']' INCR
203	= bundle(7,$3,";",geta($1),"d1+",$3,":",geta($1));
204	\| INCR LETTER '[' e ']'
205	= bundle(7,$4,";",geta($2),"1+d",$4,":",geta($2));
206	\| LETTER '[' e ']' DECR
207	= bundle(7,$3,";",geta($1),"d1-",$3,":",geta($1));
208	\| DECR LETTER '[' e ']'
209	= bundle(7,$4,";",geta($2),"1-d",$4,":",geta($2));
210	\| SCALE INCR
211	= bundle(1,"Kd1+k");
212	\| INCR SCALE
213	= bundle(1,"K1+dk");
214	\| SCALE DECR
215	= bundle(1,"Kd1-k");
216	\| DECR SCALE
217	= bundle(1,"K1-dk");
218	\| BASE INCR
219	= bundle(1,"Id1+i");
220	\| INCR BASE
221	= bundle(1,"I1+di");
222	\| BASE DECR
223	= bundle(1,"Id1-i");
224	\| DECR BASE
225	= bundle(1,"I1-di");
226	\| OBASE INCR
227	= bundle(1,"Od1+o");
228	\| INCR OBASE
229	= bundle(1,"O1+do");
230	\| OBASE DECR
231	= bundle(1,"Od1-o");
232	\| DECR OBASE
233	= bundle(1,"O1-do");
234	\| LETTER '(' cargs ')'
235	= bundle(4, $3, "l", getf($1), "x" );
236	\| LETTER '(' ')'
237	= bundle(3, "l", getf($1), "x" );
238	\| cons
239	={ bundle(2, " ", $1 ); }
240	\| DOT cons
241	={ bundle(2, " .", $2 ); }
242	\| cons DOT cons
243	={ bundle(4, " ", $1, ".", $3 ); }
244	\| cons DOT
245	={ bundle(3, " ", $1, "." ); }
246	\| DOT
247	={ $$ = "l."; }
248	\| LETTER
249	= { bundle(2, "l", $1 ); }
250	\| LETTER '=' e
251	={ bundle(3, $3, "ds", $1 ); }
252	\| LETTER EQOP e %prec '='
253	={ bundle(6, "l", $1, $3, $2, "ds", $1 ); }
254	\| LETTER '[' e ']' '=' e
255	= { bundle(5,$6,"d",$3,":",geta($1)); }
256	\| LETTER '[' e ']' EQOP e
257	= { bundle(9,$3,";",geta($1),$6,$5,"d",$3,":",geta($1)); }
258	\| LENGTH '(' e ')'
259	= bundle(2,$3,"Z");
260	\| SCALE '(' e ')'
261	= bundle(2,$3,"X"); /* must be before '(' e ')' */
262	\| '(' e ')'
263	= { $$ = $2; }
264	\| '?'
265	={ bundle(1, "?" ); }
266	\| SQRT '(' e ')'
267	={ bundle(2, $3, "v" ); }
268	\| '~' LETTER
269	={ bundle(2,"L",$2); }
270	\| SCALE '=' e
271	= bundle(2,$3,"dk");
272	\| SCALE EQOP e %prec '='
273	= bundle(4,"K",$3,$2,"dk");
274	\| BASE '=' e
275	= bundle(2,$3,"di");
276	\| BASE EQOP e %prec '='
277	= bundle(4,"I",$3,$2,"di");
278	\| OBASE '=' e
279	= bundle(2,$3,"do");
280	\| OBASE EQOP e %prec '='
281	= bundle(4,"O",$3,$2,"do");
282	\| SCALE
283	= bundle(1,"K");
284	\| BASE
285	= bundle(1,"I");
286	\| OBASE
287	= bundle(1,"O");
288	;
289
290	cargs : eora
291	\| cargs ',' eora
292	= bundle(2, $1, $3 );
293	;
294	eora: e
295	\| LETTER '[' ']'
296	=bundle(2,"l",geta($1));
297	;
298
299	cons : constant
300	={ *cp++ = '\0'; }
301
302	constant:
303	'_'
304	={ $$ = cp; *cp++ = '_'; }
305	\| DIGIT
306	={ $$ = cp; *cp++ = $1; }
307	\| constant DIGIT
308	={ *cp++ = $2; }
309	;
310
311	CRS :
312	={ $$ = cp; cp++ = crs++; cp++ = '\0';
313	if(crs == '[')crs+=3;
314	if(crs == 'a')crs='{';
315	if(crs >= 0241){yyerror("program too big");
316	getout();
317	}
318	bstack[bindx++] = lev++; }
319	;
320
321	def : _DEFINE LETTER '('
322	={ $$ = getf($2);
323	pre = "";
324	post = "";
325	lev = 1;
326	bstack[bindx=0] = 0;
327	}
328	;
329
330	dargs :
331	\| lora
332	={ pp( $1 ); }
333	\| dargs ',' lora
334	={ pp( $3 ); }
335	;
336
337	dlets : lora
338	={ tp($1); }
339	\| dlets ',' lora
340	={ tp($3); }
341	;
342	lora : LETTER
343	\| LETTER '[' ']'
344	={ $$ = geta($1); }
345	;
346
347	%%
348	# define error 256
349
350	int peekc = -1;
351	int sargc;
352	int ifile;
353	char **sargv;
354
355	char funtab[52] = {
356	01,0,02,0,03,0,04,0,05,0,06,0,07,0,010,0,011,0,012,0,013,0,014,0,015,0,016,0,017,0,
357	020,0,021,0,022,0,023,0,024,0,025,0,026,0,027,0,030,0,031,0,032,0 };
358	char atab[52] = {
359	0241,0,0242,0,0243,0,0244,0,0245,0,0246,0,0247,0,0250,0,0251,0,0252,0,0253,0,
360	0254,0,0255,0,0256,0,0257,0,0260,0,0261,0,0262,0,0263,0,0264,0,0265,0,0266,0,
361	0267,0,0270,0,0271,0,0272,0};
362	char *letr[26] = {
363	"a","b","c","d","e","f","g","h","i","j",
364	"k","l","m","n","o","p","q","r","s","t",
365	"u","v","w","x","y","z" } ;
366	char *dot = { "." };
367	yylex(){
368	int c, ch;
369	restart:
370	c = getch();
371	peekc = -1;
372	while( c == ' ' \|\| c == '\t' ) c = getch();
373	if(c == '\\'){
374	getch();
375	goto restart;
376	}
377	if( c<= 'z' && c >= 'a' ) {
378	/* look ahead to look for reserved words */
379	peekc = getch();
380	if( peekc >= 'a' && peekc <= 'z' ){ /* must be reserved word */
381	if( c=='i' && peekc=='f' ){ c=_IF; goto skip; }
382	if( c=='w' && peekc=='h' ){ c=_WHILE; goto skip; }
383	if( c=='f' && peekc=='o' ){ c=_FOR; goto skip; }
384	if( c=='s' && peekc=='q' ){ c=SQRT; goto skip; }
385	if( c=='r' && peekc=='e' ){ c=_RETURN; goto skip; }
386	if( c=='b' && peekc=='r' ){ c=_BREAK; goto skip; }
387	if( c=='d' && peekc=='e' ){ c=_DEFINE; goto skip; }
388	if( c=='s' && peekc=='c' ){ c= SCALE; goto skip; }
389	if( c=='b' && peekc=='a' ){ c=BASE; goto skip; }
390	if( c=='i' && peekc == 'b'){ c=BASE; goto skip; }
391	if( c=='o' && peekc=='b' ){ c=OBASE; goto skip; }
392	if( c=='d' && peekc=='i' ){ c=FFF; goto skip; }
393	if( c=='a' && peekc=='u' ){ c=_AUTO; goto skip; }
394	if( c == 'l' && peekc=='e'){ c=LENGTH; goto skip; }
395	if( c == 'q' && peekc == 'u'){getout();}
396	/* could not be found */
397	return( error );
398	skip: /* skip over rest of word */
399	peekc = -1;
400	while( (ch = getch()) >= 'a' && ch <= 'z' );
401	peekc = ch;
402	return( c );
403	}
404
405	/* usual case; just one single letter */
406
407	yylval = letr[c-'a'];
408	return( LETTER );
409	}
410	if( c>= '0' && c <= '9' \|\| c>= 'A' && c<= 'F' ){
411	yylval = c;
412	return( DIGIT );
413	}
414	switch( c ){
415	case '.': return( DOT );
416	case '=':
417	switch( peekc = getch() ){
418	case '=': c=EQ; goto gotit;
419	case '+': c=EQPL; goto gotit;
420	case '-': c=EQMI; goto gotit;
421	case '*': c=EQMUL; goto gotit;
422	case '/': c=EQDIV; goto gotit;
423	case '%': c=EQREM; goto gotit;
424	case '^': c=EQEXP; goto gotit;
425	default: return( '=' );
426	gotit: peekc = -1; return(c);
427	}
3321b8ce BJ	428	case '+': return( cpeek( '+', INCR, cpeek( '=', EQPL, '+') ) );
3321b8ce BJ	429	case '-': return( cpeek( '-', DECR, cpeek( '=', EQMI, '-') ) );
a27f2922 BJ	430	case '<': return( cpeek( '=', LE, '<' ) );
	431	case '>': return( cpeek( '=', GE, '>' ) );
	432	case '!': return( cpeek( '=', NE, '!' ) );
	433	case '/':
	434	if((peekc = getch()) == '*'){
	435	peekc = -1;
	436	while((getch() != '*') \|\| ((peekc = getch()) != '/'));
	437	peekc = -1;
	438	goto restart;
	439	}
3321b8ce BJ	440	else if (peekc == '=') {
	441	c=EQDIV;
	442	goto gotit;
	443	}
a27f2922	444	else return(c);
3321b8ce BJ	445	case '*':
	446	return( cpeek( '=', EQMUL, '*' ) );
	447	case '%':
	448	return( cpeek( '=', EQREM, '%' ) );
	449	case '^':
	450	return( cpeek( '=', EQEXP, '^' ) );
a27f2922 BJ	451	case '"':
	452	yylval = str;
	453	while((c=getch()) != '"'){*str++ = c;
	454	if(str >= &string[999]){yyerror("string space exceeded");
	455	getout();
	456	}
	457	}
	458	*str++ = '\0';
	459	return(QSTR);
	460	default: return( c );
	461	}
	462	}
	463
	464	cpeek( c, yes, no ){
	465	if( (peekc=getch()) != c ) return( no );
	466	else {
	467	peekc = -1;
	468	return( yes );
	469	}
	470	}
	471
	472	getch(){
	473	int ch;
	474	loop:
	475	ch = (peekc < 0) ? getc(in) : peekc;
	476	peekc = -1;
	477	if(ch != EOF)return(ch);
	478	if(++ifile > sargc){
	479	if(ifile >= sargc+2)getout();
	480	in = stdin;
	481	ln = 0;
	482	goto loop;
	483	}
	484	fclose(in);
	485	if((in = fopen(sargv[ifile],"r")) != NULL){
	486	ln = 0;
	487	ss = sargv[ifile];
	488	goto loop;
	489	}
	490	yyerror("cannot open input file");
	491	}
	492	# define b_sp_max 3000
	493	int b_space [ b_sp_max ];
	494	int * b_sp_nxt = { b_space };
	495
	496	int bdebug = 0;
6d987ad7 KB	497	/VARARGS/
	498	bundle(va_alist) va_dcl {
	499	va_list ap;
	500	int i, *q;
a27f2922	501
6d987ad7 KB	502	va_start(ap);
6d987ad7 KB	503	i = va_arg(ap, int);
a27f2922 BJ	504	q = b_sp_nxt;
	505	if( bdebug ) printf("bundle %d elements at %o\n",i, q );
	506	while(i-- > 0){
	507	if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" );
6d987ad7	508	* b_sp_nxt++ = va_arg(ap, int);
a27f2922 BJ	509	}
	510	* b_sp_nxt++ = 0;
	511	yyval = q;
6d987ad7	512	va_end(ap);
a27f2922 BJ	513	return( q );
	514	}
	515
	516	routput(p) int *p; {
	517	if( bdebug ) printf("routput(%o)\n", p );
	518	if( p >= &b_space[0] && p < &b_space[b_sp_max]){
	519	/* part of a bundle */
	520	while( p != 0 ) routput( p++ );
	521	}
	522	else printf( p ); /* character string */
	523	}
	524
	525	output( p ) int *p; {
	526	routput( p );
	527	b_sp_nxt = & b_space[0];
	528	printf( "\n" );
	529	fflush(stdout);
	530	cp = cary;
	531	crs = rcrs;
	532	}
	533
	534	conout( p, s ) int p; char s; {
	535	printf("[");
	536	routput( p );
	537	printf("]s%s\n", s );
	538	fflush(stdout);
	539	lev--;
	540	}
	541
	542	yyerror( s ) char *s; {
	543	if(ifile > sargc)ss="teletype";
	544	printf("c[%s on line %d, %s]pc\n", s ,ln+1,ss);
	545	fflush(stdout);
	546	cp = cary;
	547	crs = rcrs;
	548	bindx = 0;
	549	lev = 0;
	550	b_sp_nxt = &b_space[0];
	551	}
	552
	553	pp( s ) char *s; {
	554	/* puts the relevant stuff on pre and post for the letter s */
	555
	556	bundle(3, "S", s, pre );
	557	pre = yyval;
	558	bundle(4, post, "L", s, "s." );
	559	post = yyval;
	560	}
	561
	562	tp( s ) char s; { / same as pp, but for temps */
	563	bundle(3, "0S", s, pre );
	564	pre = yyval;
	565	bundle(4, post, "L", s, "s." );
	566	post = yyval;
	567	}
	568
	569	yyinit(argc,argv) int argc; char *argv[];{
392fe950	570	(void)signal(SIGINT, SIG_IGN); /* ignore all interrupts */
a27f2922 BJ	571	sargv=argv;
	572	sargc= -- argc;
	573	if(sargc == 0)in=stdin;
db2c044e	574	else if((in = fopen(sargv[1],"r")) == NULL) {
a27f2922	575	yyerror("cannot open input file");
db2c044e SL	576	in = stdin;
db2c044e SL	577	}
a27f2922 BJ	578	ifile = 1;
	579	ln = 0;
	580	ss = sargv[1];
	581	}
	582	int *getout(){
	583	printf("q");
	584	fflush(stdout);
6d987ad7	585	exit(0);
a27f2922 BJ	586	}
	587
	588	int *
	589	getf(p) char *p;{
	590	return(&funtab[2(p -0141)]);
	591	}
	592	int *
	593	geta(p) char *p;{
	594	return(&atab[2(p - 0141)]);
	595	}
	596
	597	main(argc, argv)
	598	char **argv;
	599	{
	600	int p[2];
	601
	602
	603	if (argc > 1 && *argv[1] == '-') {
	604	if((argv[1][1] == 'd')\|\|(argv[1][1] == 'c')){
	605	yyinit(--argc, ++argv);
	606	yyparse();
6d987ad7	607	exit(0);
a27f2922 BJ	608	}
	609	if(argv[1][1] != 'l'){
	610	printf("unrecognizable argument\n");
	611	fflush(stdout);
6d987ad7	612	exit(1);
a27f2922	613	}
0092fa3d	614	argv[1] = _PATH_LIBB;
a27f2922 BJ	615	}
	616	pipe(p);
	617	if (fork()==0) {
	618	close(1);
	619	dup(p[1]);
	620	close(p[0]);
	621	close(p[1]);
	622	yyinit(argc, argv);
	623	yyparse();
6d987ad7	624	exit(0);
a27f2922 BJ	625	}
	626	close(0);
	627	dup(p[0]);
	628	close(p[0]);
	629	close(p[1]);
0092fa3d	630	execl(_PATH_DC, "dc", "-", (char *)0);
6d987ad7 KB	631	perror("bc: can't find dc");
6d987ad7 KB	632	exit(1);
a27f2922	633	}