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