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