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