xref: /original-bsd/usr.bin/bc/bc.y (revision c3e32dec) 
1 %{
2 /*-
3  * Copyright (c) 1991, 1993
4  *	The Regents of the University of California.  All rights reserved.
5  *
6  * %sccs.include.proprietary.c%
7  */
8 
9 #ifndef lint
10 static char copyright[] =
11 "@(#) Copyright (c) 1991, 1993\n\
12 	The Regents of the University of California.  All rights reserved.\n";
13 #endif /* not lint */
14 
15 #ifndef lint
16 static char sccsid[] = "@(#)bc.y	8.1 (Berkeley) 06/06/93";
17 #endif /* not lint */
18 
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 %{
35 #include <sys/signal.h>
36 #include <stdio.h>
37 #include <varargs.h>
38 #include "pathnames.h"
39 FILE *in;
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 		  }
428 	case '+':	return( cpeek( '+', INCR, cpeek( '=', EQPL, '+') ) );
429 	case '-':	return( cpeek( '-', DECR, cpeek( '=', EQMI, '-') ) );
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 		}
440 		else if (peekc == '=') {
441 			c=EQDIV;
442 			goto gotit;
443 		}
444 		else return(c);
445 	case '*':
446 		return( cpeek( '=', EQMUL, '*' ) );
447 	case '%':
448 		return( cpeek( '=', EQREM, '%' ) );
449 	case '^':
450 		return( cpeek( '=', EQEXP, '^' ) );
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;
497 /*VARARGS*/
498 bundle(va_alist) va_dcl {
499 	va_list ap;
500 	int i, *q;
501 
502 	va_start(ap);
503 	i = va_arg(ap, int);
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" );
508 		* b_sp_nxt++ = va_arg(ap, int);
509 	}
510 	* b_sp_nxt++ = 0;
511 	yyval = q;
512 	va_end(ap);
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[];{
570 	(void)signal(SIGINT, SIG_IGN);	/* ignore all interrupts */
571 	sargv=argv;
572 	sargc= -- argc;
573 	if(sargc == 0)in=stdin;
574 	else if((in = fopen(sargv[1],"r")) == NULL) {
575 		yyerror("cannot open input file");
576 		in = stdin;
577 	}
578 	ifile = 1;
579 	ln = 0;
580 	ss = sargv[1];
581 }
582 int *getout(){
583 	printf("q");
584 	fflush(stdout);
585 	exit(0);
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();
607 			exit(0);
608 		}
609 		if(argv[1][1] != 'l'){
610 			printf("unrecognizable argument\n");
611 			fflush(stdout);
612 			exit(1);
613 		}
614 		argv[1] = _PATH_LIBB;
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();
624 		exit(0);
625 	}
626 	close(0);
627 	dup(p[0]);
628 	close(p[0]);
629 	close(p[1]);
630 	execl(_PATH_DC, "dc", "-", (char *)0);
631 	perror("bc: can't find dc");
632 	exit(1);
633 }
634