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