UNIX 6th Ed. - /usr/source/s1/bc.y

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

Defined functions

Defined variables

Defined macros