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 } 618