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