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