V6/usr/source/s1/bc.y

%right '='
%left '+' '-'
%left '*' '/' '%'
%right '^'
%left UMINUS
%term LETTER DIGIT SQRT _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
%{
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 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( pre, 7,ドル post );
			conout( $,ドル 2ドル );
			rcrs = crs;
			output( "" );
			lev = bindx = 0;
			}
	;
dlist	: tail
	| dlist _AUTO dlets tail
	;
stat	: e 
		={ bundle( 1,ドル "ps." ); }
	| 
		={ bundle( "" ); }
	| QSTR
		={ bundle("[",1,ドル"]P");}
	| LETTER '=' e
		={ bundle( 3,ドル "s", 1ドル ); }
	| LETTER '[' e ']' '=' e
		={ bundle( 6,ドル 3,ドル ":", geta(1ドル)); }
	| LETTER EQOP e
		={ bundle( "l", 1,ドル 3,ドル 2,ドル "s", 1ドル ); }
	| LETTER '[' e ']' EQOP e
		={ bundle(3,ドル ";", geta(1ドル), 6,ドル 5,ドル 3,ドル ":", geta(1ドル));}
	| _BREAK
		={ bundle( numb[lev-bstack[bindx-1]], "Q" ); }
	| _RETURN '(' e ')'
		= bundle( 3,ドル post, numb[lev], "Q" );
	| _RETURN '(' ')'
		= bundle( "0", post, numb[lev], "Q" );
	| SCALE e
		= bundle( 2,ドル "k" );
	| SCALE '=' e
		= bundle( 3,ドル "k");
	| SCALE EQOP e
		= bundle("K",3,ドル2,ドル"k");
	| BASE e
		= bundle( 2,ドル "i" );
	| BASE '=' e
		= bundle(3,ドル "i");
	| BASE EQOP e
		= bundle("I",3,ドル2,ドル"i");
	| OBASE e
		= bundle( 2,ドル "o" );
	| OBASE '=' e
		= bundle(3,ドル"o");
	| OBASE EQOP e
		= bundle("O",3,ドル2,ドル"o");
	| '{' slist '}'
		={ $$ = 2ドル; }
	| FFF
		={ bundle("f"); }
	| error
		={ bundle("c"); }
	| _IF CRS BLEV '(' re ')' stat
		={	conout( 7,ドル 2ドル );
			bundle( 5,ドル 2,ドル " " );
			}
	| _WHILE CRS '(' re ')' stat BLEV
		={	bundle( 6,ドル 4,ドル 2ドル );
			conout( $,ドル 2ドル );
			bundle( 4,ドル 2,ドル " " );
			}
	| fprefix CRS re ';' e ')' stat BLEV
		={	bundle( 7,ドル 5,ドル "s.", 3,ドル 2ドル );
			conout( $,ドル 2ドル );
			bundle( 1,ドル "s.", 3,ドル 2,ドル " " );
			}
	| '~' LETTER '=' e
		={	bundle(4,ドル"S",2ドル); }
	;
EQOP	: EQPL
		={ $$ = "+"; }
	| EQMI
		={ $$ = "-"; }
	| EQMUL
		={ $$ = "*"; }
	| EQDIV
		={ $$ = "/"; }
	| EQREM
		={ $$ = "%%"; }
	| EQEXP
		={ $$ = "^"; }
	;
fprefix	: _FOR '(' e ';'
		={ $$ = 3ドル; }
	;
BLEV	:
		={ --bindx; }
	;
slist	: stat
	| slist tail stat
		={ bundle( 1,ドル 3ドル ); }
	;
tail	: '\n'
	| ';'
	;
re	: e EQ e
		= bundle( 1,ドル 3,ドル "=" );
	| e '<' e
		= bundle( 1,ドル 3,ドル ">" );
	| e '>' e
		= bundle( 1,ドル 3,ドル "<" );
	| e NE e
		= bundle( 1,ドル 3,ドル "!=" );
	| e GE e
		= bundle( 1,ドル 3,ドル "!>" );
	| e LE e
		= bundle( 1,ドル 3,ドル "!<" );
	| e
		= bundle( 1,ドル " 0!=" );
	;
e	: e '+' e
		= bundle( 1,ドル 3,ドル "+" );
	| e '-' e
		= bundle( 1,ドル 3,ドル "-" );
	| '-' e		%prec UMINUS
		= bundle( " 0", 2,ドル "-" );
	| e '*' e
		= bundle( 1,ドル 3,ドル "*" );
	| e '/' e
		= bundle( 1,ドル 3,ドル "/" );
	| e '%' e
		= bundle( 1,ドル 3,ドル "%%" );
	| e '^' e
		= bundle( 1,ドル 3,ドル "^" );
	| LETTER '[' e ']'
		={ bundle(3,ドル ";", geta(1ドル)); }
	| LETTER INCR
		= bundle( "l", 1,ドル "d1+s", 1ドル );
	| INCR LETTER
		= bundle( "l", 2,ドル "1+ds", 2ドル );
	| DECR LETTER
		= bundle( "l", 2,ドル "1-ds", 2ドル );
	| LETTER DECR
		= bundle( "l", 1,ドル "d1-s", 1ドル );
	| LETTER '[' e ']' INCR
		= bundle(3,ドル";",geta(1ドル),"d1+",3,ドル":",geta(1ドル));
	| INCR LETTER '[' e ']'
		= bundle(4,ドル";",geta(2ドル),"1+d",4,ドル":",geta(2ドル));
	| LETTER '[' e ']' DECR
		= bundle(3,ドル";",geta(1ドル),"d1-",3,ドル":",geta(1ドル));
	| DECR LETTER '[' e ']'
		= bundle(4,ドル";",geta(2ドル),"1-d",4,ドル":",geta(2ドル));
	| SCALE INCR
		= bundle("Kd1+k");
	| INCR SCALE
		= bundle("K1+dk");
	| SCALE DECR
		= bundle("Kd1-k");
	| DECR SCALE
		= bundle("K1-dk");
	| BASE INCR
		= bundle("Id1+i");
	| INCR BASE
		= bundle("I1+di");
	| BASE DECR
		= bundle("Id1-i");
	| DECR BASE
		= bundle("I1-di");
	| OBASE INCR
		= bundle("Od1+o");
	| INCR OBASE
		= bundle("O1+do");
	| OBASE DECR
		= bundle("Od1-o");
	| DECR OBASE
		= bundle("O1-do");
	| LETTER '(' cargs ')'
		= bundle( 3,ドル "l", getf(1ドル), "x" );
	| LETTER '(' ')'
		= bundle( "l", getf(1ドル), "x" );
	| cons
		={ bundle( " ", 1ドル ); }
	| DOT cons
		={ bundle( " .", 2ドル ); }
	| cons DOT cons
		={ bundle( " ", 1,ドル ".", 3ドル ); }
	| cons DOT
		={ bundle( " ", 1,ドル "." ); }
	| DOT
		={ $$ = "l."; }
	| LETTER
		= { bundle( "l", 1ドル ); }
	| LETTER '=' e
		={ bundle( 3,ドル "ds", 1ドル ); }
	| LETTER EQOP e	%prec '='
		={ bundle( "l", 1,ドル 3,ドル 2,ドル "ds", 1ドル ); }
	| '(' e ')'
		= { $$ = 2ドル; }
	| '?'
		={ bundle( "?" ); }
	| SQRT '(' e ')'
		={ bundle( 3,ドル "v" ); }
		| '~' LETTER
		={ bundle("L",2ドル); }
	| SCALE e
		= bundle(2,ドル"dk");
	| SCALE '=' e
		= bundle(3,ドル"dk");
	| SCALE EQOP e		%prec '='
		= bundle("K",3,ドル2,ドル"dk");
	| BASE e
		= bundle(2,ドル"di");
	| BASE '=' e
		= bundle(3,ドル"di");
	| BASE EQOP e		%prec '='
		= bundle("I",3,ドル2,ドル"di");
	| OBASE e
		= bundle(2,ドル"do");
	| OBASE '=' e
		= bundle(3,ドル"do");
	| OBASE EQOP e		%prec '='
		= bundle("O",3,ドル2,ドル"do");
	| SCALE
		= bundle("K");
	| BASE
		= bundle("I");
	| OBASE
		= bundle("O");
	;
cargs	: eora
	| cargs ',' eora
		= bundle( 1,ドル 3ドル );
	;
eora:	 e
	| LETTER '[' ']'
		=bundle("l",geta(1ドル));
	;
cons	: constant
		={ *cp++ = '0円'; }
constant:
	 '_'
		={ $$ = cp; *cp++ = '_'; }
	| DIGIT
		={ $$ = cp; *cp++ = 1ドル; }
	| constant DIGIT
		={ *cp++ = 2ドル; }
	;
CRS	:
		={ $$ = cp; *cp++ = crs++; *cp++ = '0円'; 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;
extern int fin;
char *funtab[26]{
	01,02,03,04,05,06,07,010,011,012,013,014,015,016,017,
	020,021,022,023,024,025,026,027,030,031,032 };
char *atab[26]{
	0241,0242,0243,0244,0245,0246,0247,0250,0251,0252,0253,
	0254,0255,0256,0257,0260,0261,0262,0263,0264,0265,0266,
	0267,0270,0271,0272};
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 = getc();
 peekc = -1;
 while( c == ' ' || c == '\t' ) c = getc();
 if( c<= 'z' && c >= 'a' ) {
 /* look ahead to look for reserved words */
 peekc = getc();
 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=='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 == 'q' && peekc == 'u')getout();
 /* could not be found */
 return( error );
 skip: /* skip over rest of word */
	peekc = -1;
 while( (ch = getc()) >= '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 = getc() ){
 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, '+' ) );
 case '-': return( cpeek( '-', DECR, '-' ) );
 case '<': return( cpeek( '=', LE, '<' ) );
 case '>': return( cpeek( '=', GE, '>' ) );
 case '!': return( cpeek( '=', NE, '!' ) );
 case '/':
	if((peekc = getc()) == '*'){
		peekc = -1;
		while((getc() != '*') || ((peekc = getc()) != '/'));
		peekc = -1;
		goto restart;
	}
	else return(c);
 case '"': 
	 yylval = str;
	 while((c=getc()) != '"')*str++ = c;
	 *str++ = '0円';
	 return(QSTR);
 default: return( c );
 }
 }
cpeek( c, yes, no ){
 if( (peekc=getc()) != c ) return( no );
 else {
 peekc = -1;
 return( yes );
 }
 }
getc(){
 int ch;
loop:
 ch = (peekc < 0) ? getchar() : peekc;
 peekc = -1;
 if(ch != '0円')return(ch);
 if(++ifile > sargc){
	if(ifile >= sargc+2)getout();
	fin = dup(0);
	goto loop;
 }
close(fin);
 if((fin = open(sargv[ifile],0)) >= 0)goto loop;
 yyerror("cannot open input file");
}
# define b_sp_max 1500
int b_space [ b_sp_max ];
int * b_sp_nxt { b_space };
bdebug 0;
bundle(a){
 int i, *p, *q;
 i = nargs();
 q = b_sp_nxt;
 if( bdebug ) printf("bundle %d elements at %o\n", i, q );
 for( p = &a; i-->0; ++p ){
 if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" );
 * b_sp_nxt++ = *p;
 }
 * b_sp_nxt++ = 0;
 yyval = q;
 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" );
 cp = cary;
 str = string;
 crs = rcrs;
 }
conout( p, s ) int *p; char *s; {
 printf("[");
 routput( p );
 printf("]s%s\n", s );
 lev--;
 str = string;
 }
yyerror( s ) char *s; {
 printf("c[%s]pc\n", s );
 cp = cary;
 crs = rcrs;
 bindx = 0;
 lev = 0;
 b_sp_nxt = &b_space[0];
 str = string;
 }
pp( s ) char *s; {
 /* puts the relevant stuff on pre and post for the letter s */
 bundle( "S", s, pre );
 pre = yyval;
 bundle( post, "L", s, "s." );
 post = yyval;
 }
tp( s ) char *s; { /* same as pp, but for temps */
 bundle( "0S", s, pre );
 pre = yyval;
 bundle( post, "L", s, "s." );
 post = yyval;
 }
yyinit(argc,argv) int argc; char *argv[];{
 int (*getout)();
 signal( 2, getout ); /* ignore all interrupts */
 sargv=argv;
 sargc= -- argc;
 if(sargc == 0)fin=dup(0);
 else if((fin = open(sargv[1],0)) < 0)
	yyerror("cannot open input file");
 ifile = 1;
 }
getout(){
printf("q");
exit();
}
getf(p) char *p;{
return(&funtab[*p -0141]);
}
geta(p) char *p;{
	return(&atab[*p - 0141]);
}
main(argc, argv)
char **argv;
{
	int p[2];
	if (argc > 1 && *argv[1] == '-') {
		if(argv[1][1] == 'd'){
			yyinit(--argc, ++argv);
			yyparse();
			exit();
		}
		if(argv[1][1] != 'l'){
			printf("unrecognizable argument\n");
			exit();
		}
		argv[1] = "/usr/lib/lib.b";
	}
	pipe(p);
	if (fork()==0) {
		close(1);
		dup(p[1]);
		close(p[0]);
		close(p[1]);
		yyinit(argc, argv);
		yyparse();
		exit();
	}
	close(0);
	dup(p[0]);
	close(p[0]);
	close(p[1]);
	execl("/bin/dc", "dc", "-", 0);
}