2.9BSD - /usr/src/cmd/bc.y

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

Defined functions

Defined variables

Defined macros