|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.