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