|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.