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