1: %{ 2: static char *sccsid = "@(#)bc.y 4.3 (Berkeley) 85/11/28"; 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, cpeek( '=', EQPL, '+') ) ); 410: case '-': return( cpeek( '-', DECR, cpeek( '=', EQMI, '-') ) ); 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 if (peekc == '=') { 422: c=EQDIV; 423: goto gotit; 424: } 425: else return(c); 426: case '*': 427: return( cpeek( '=', EQMUL, '*' ) ); 428: case '%': 429: return( cpeek( '=', EQREM, '%' ) ); 430: case '^': 431: return( cpeek( '=', EQEXP, '^' ) ); 432: case '"': 433: yylval = str; 434: while((c=getch()) != '"'){*str++ = c; 435: if(str >= &string[999]){yyerror("string space exceeded"); 436: getout(); 437: } 438: } 439: *str++ = '\0'; 440: return(QSTR); 441: default: return( c ); 442: } 443: } 444: 445: cpeek( c, yes, no ){ 446: if( (peekc=getch()) != c ) return( no ); 447: else { 448: peekc = -1; 449: return( yes ); 450: } 451: } 452: 453: getch(){ 454: int ch; 455: loop: 456: ch = (peekc < 0) ? getc(in) : peekc; 457: peekc = -1; 458: if(ch != EOF)return(ch); 459: if(++ifile > sargc){ 460: if(ifile >= sargc+2)getout(); 461: in = stdin; 462: ln = 0; 463: goto loop; 464: } 465: fclose(in); 466: if((in = fopen(sargv[ifile],"r")) != NULL){ 467: ln = 0; 468: ss = sargv[ifile]; 469: goto loop; 470: } 471: yyerror("cannot open input file"); 472: } 473: # define b_sp_max 3000 474: int b_space [ b_sp_max ]; 475: int * b_sp_nxt = { b_space }; 476: 477: int bdebug = 0; 478: bundle(a){ 479: int i, *p, *q; 480: 481: p = &a; 482: i = *p++; 483: q = b_sp_nxt; 484: if( bdebug ) printf("bundle %d elements at %o\n",i, q ); 485: while(i-- > 0){ 486: if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" ); 487: * b_sp_nxt++ = *p++; 488: } 489: * b_sp_nxt++ = 0; 490: yyval = q; 491: return( q ); 492: } 493: 494: routput(p) int *p; { 495: if( bdebug ) printf("routput(%o)\n", p ); 496: if( p >= &b_space[0] && p < &b_space[b_sp_max]){ 497: /* part of a bundle */ 498: while( *p != 0 ) routput( *p++ ); 499: } 500: else printf( p ); /* character string */ 501: } 502: 503: output( p ) int *p; { 504: routput( p ); 505: b_sp_nxt = & b_space[0]; 506: printf( "\n" ); 507: fflush(stdout); 508: cp = cary; 509: crs = rcrs; 510: } 511: 512: conout( p, s ) int *p; char *s; { 513: printf("["); 514: routput( p ); 515: printf("]s%s\n", s ); 516: fflush(stdout); 517: lev--; 518: } 519: 520: yyerror( s ) char *s; { 521: if(ifile > sargc)ss="teletype"; 522: printf("c[%s on line %d, %s]pc\n", s ,ln+1,ss); 523: fflush(stdout); 524: cp = cary; 525: crs = rcrs; 526: bindx = 0; 527: lev = 0; 528: b_sp_nxt = &b_space[0]; 529: } 530: 531: pp( s ) char *s; { 532: /* puts the relevant stuff on pre and post for the letter s */ 533: 534: bundle(3, "S", s, pre ); 535: pre = yyval; 536: bundle(4, post, "L", s, "s." ); 537: post = yyval; 538: } 539: 540: tp( s ) char *s; { /* same as pp, but for temps */ 541: bundle(3, "0S", s, pre ); 542: pre = yyval; 543: bundle(4, post, "L", s, "s." ); 544: post = yyval; 545: } 546: 547: yyinit(argc,argv) int argc; char *argv[];{ 548: signal( 2, (int(*)())1 ); /* ignore all interrupts */ 549: sargv=argv; 550: sargc= -- argc; 551: if(sargc == 0)in=stdin; 552: else if((in = fopen(sargv[1],"r")) == NULL) { 553: yyerror("cannot open input file"); 554: in = stdin; 555: } 556: ifile = 1; 557: ln = 0; 558: ss = sargv[1]; 559: } 560: int *getout(){ 561: printf("q"); 562: fflush(stdout); 563: exit(); 564: } 565: 566: int * 567: getf(p) char *p;{ 568: return(&funtab[2*(*p -0141)]); 569: } 570: int * 571: geta(p) char *p;{ 572: return(&atab[2*(*p - 0141)]); 573: } 574: 575: main(argc, argv) 576: char **argv; 577: { 578: int p[2]; 579: 580: 581: if (argc > 1 && *argv[1] == '-') { 582: if((argv[1][1] == 'd')||(argv[1][1] == 'c')){ 583: yyinit(--argc, ++argv); 584: yyparse(); 585: exit(); 586: } 587: if(argv[1][1] != 'l'){ 588: printf("unrecognizable argument\n"); 589: fflush(stdout); 590: exit(); 591: } 592: argv[1] = "/usr/lib/lib.b"; 593: } 594: pipe(p); 595: if (fork()==0) { 596: close(1); 597: dup(p[1]); 598: close(p[0]); 599: close(p[1]); 600: yyinit(argc, argv); 601: yyparse(); 602: exit(); 603: } 604: close(0); 605: dup(p[0]); 606: close(p[0]); 607: close(p[1]); 608: execl("/bin/dc", "dc", "-", 0); 609: execl("/usr/bin/dc", "dc", "-", 0); 610: }
|
Last modified: 1985-11-29
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1306 |
|