Blob


1 %{
2 #include <u.h>
3 #include <libc.h>
4 #include <bio.h>
6 #define bsp_max 5000
8 Biobuf *in;
9 Biobuf bstdin;
10 Biobuf bstdout;
11 char cary[1000];
12 char* cp = { cary };
13 char string[1000];
14 char* str = { string };
15 int crs = 128;
16 int rcrs = 128; /* reset crs */
17 int bindx = 0;
18 int lev = 0;
19 int ln;
20 char* ttp;
21 char* ss = "";
22 int bstack[10] = { 0 };
23 char* numb[15] =
24 {
25 " 0", " 1", " 2", " 3", " 4", " 5",
26 " 6", " 7", " 8", " 9", " 10", " 11",
27 " 12", " 13", " 14"
28 };
29 char* pre;
30 char* post;
32 long peekc = -1;
33 int sargc;
34 int ifile;
35 char** sargv;
37 char *funtab[] =
38 {
39 "<1>","<2>","<3>","<4>","<5>",
40 "<6>","<7>","<8>","<9>","<10>",
41 "<11>","<12>","<13>","<14>","<15>",
42 "<16>","<17>","<18>","<19>","<20>",
43 "<21>","<22>","<23>","<24>","<25>",
44 "<26>"
45 };
46 char *atab[] =
47 {
48 "<221>","<222>","<223>","<224>","<225>",
49 "<226>","<227>","<228>","<229>","<230>",
50 "<231>","<232>","<233>","<234>","<235>",
51 "<236>","<237>","<238>","<239>","<240>",
52 "<241>","<242>","<243>","<244>","<245>",
53 "<246>"
54 };
55 char* letr[26] =
56 {
57 "a","b","c","d","e","f","g","h","i","j",
58 "k","l","m","n","o","p","q","r","s","t",
59 "u","v","w","x","y","z"
60 };
61 char* dot = { "." };
62 char* bspace[bsp_max];
63 char** bsp_nxt = bspace;
64 int bdebug = 0;
65 int lflag;
66 int cflag;
67 int sflag;
69 char* bundle(int, ...);
70 void conout(char*, char*);
71 int cpeek(int, int, int);
72 int getch(void);
73 char* geta(char*);
74 char* getf(char*);
75 void getout(void);
76 void output(char*);
77 void pp(char*);
78 void routput(char*);
79 void tp(char*);
80 void yyerror(char*, ...);
81 int yyparse(void);
83 typedef void* pointer;
84 #pragma varargck type "lx" pointer
86 %}
87 %union
88 {
89 char* cptr;
90 int cc;
91 }
93 %type <cptr> pstat stat stat1 def slist dlets e ase nase
94 %type <cptr> slist re fprefix cargs eora cons constant lora
95 %type <cptr> crs
97 %token <cptr> LETTER EQOP _AUTO DOT
98 %token <cc> DIGIT SQRT LENGTH _IF FFF EQ
99 %token <cc> _PRINT _WHILE _FOR NE LE GE INCR DECR
100 %token <cc> _RETURN _BREAK _DEFINE BASE OBASE SCALE
101 %token <cc> QSTR ERROR
103 %right '=' EQOP
104 %left '+' '-'
105 %left '*' '/' '%'
106 %right '^'
107 %left UMINUS
109 %%
110 start:
111 start stuff
112 | stuff
114 stuff:
115 pstat tail
117 output($1);
119 | def dargs ')' '{' dlist slist '}'
121 ttp = bundle(6, pre, $6, post , "0", numb[lev], "Q");
122 conout(ttp, (char*)$1);
123 rcrs = crs;
124 output("");
125 lev = bindx = 0;
128 dlist:
129 tail
130 | dlist _AUTO dlets tail
132 stat:
133 stat1
134 | nase
136 if(sflag)
137 bundle(2, $1, "s.");
140 pstat:
141 stat1
143 if(sflag)
144 bundle(2, $1, "0");
146 | nase
148 if(!sflag)
149 bundle(2, $1, "ps.");
152 stat1:
154 bundle(1, "");
156 | ase
158 bundle(2, $1, "s.");
160 | SCALE '=' e
162 bundle(2, $3, "k");
164 | SCALE EQOP e
166 bundle(4, "K", $3, $2, "k");
168 | BASE '=' e
170 bundle(2, $3, "i");
172 | BASE EQOP e
174 bundle(4, "I", $3, $2, "i");
176 | OBASE '=' e
178 bundle(2, $3, "o");
180 | OBASE EQOP e
182 bundle(4, "O", $3, $2, "o");
184 | QSTR
186 bundle(3, "[", $1, "]P");
188 | _BREAK
190 bundle(2, numb[lev-bstack[bindx-1]], "Q");
192 | _PRINT e
194 bundle(2, $2, "ps.");
196 | _RETURN e
198 bundle(4, $2, post, numb[lev], "Q");
200 | _RETURN
202 bundle(4, "0", post, numb[lev], "Q");
204 | '{' slist '}'
206 $$ = $2;
208 | FFF
210 bundle(1, "fY");
212 | _IF crs BLEV '(' re ')' stat
214 conout($7, $2);
215 bundle(3, $5, $2, " ");
217 | _WHILE crs '(' re ')' stat BLEV
219 bundle(3, $6, $4, $2);
220 conout($$, $2);
221 bundle(3, $4, $2, " ");
223 | fprefix crs re ';' e ')' stat BLEV
225 bundle(5, $7, $5, "s.", $3, $2);
226 conout($$, $2);
227 bundle(5, $1, "s.", $3, $2, " ");
229 | '~' LETTER '=' e
231 bundle(3, $4, "S", $2);
234 fprefix:
235 _FOR '(' e ';'
237 $$ = $3;
240 BLEV:
243 --bindx;
246 slist:
247 stat
248 | slist tail stat
250 bundle(2, $1, $3);
253 tail:
254 '\n'
256 ln++;
258 | ';'
260 re:
261 e EQ e
263 $$ = bundle(3, $1, $3, "=");
265 | e '<' e
267 bundle(3, $1, $3, ">");
269 | e '>' e
271 bundle(3, $1, $3, "<");
273 | e NE e
275 bundle(3, $1, $3, "!=");
277 | e GE e
279 bundle(3, $1, $3, "!>");
281 | e LE e
283 bundle(3, $1, $3, "!<");
285 | e
287 bundle(2, $1, " 0!=");
290 nase:
291 '(' e ')'
293 $$ = $2;
295 | cons
297 bundle(3, " ", $1, " ");
299 | DOT cons
301 bundle(3, " .", $2, " ");
303 | cons DOT cons
305 bundle(5, " ", $1, ".", $3, " ");
307 | cons DOT
309 bundle(4, " ", $1, ".", " ");
311 | DOT
313 $<cptr>$ = "l.";
315 | LETTER '[' e ']'
317 bundle(3, $3, ";", geta($1));
319 | LETTER INCR
321 bundle(4, "l", $1, "d1+s", $1);
323 | INCR LETTER
325 bundle(4, "l", $2, "1+ds", $2);
327 | DECR LETTER
329 bundle(4, "l", $2, "1-ds", $2);
331 | LETTER DECR
333 bundle(4, "l", $1, "d1-s", $1);
335 | LETTER '[' e ']' INCR
337 bundle(7, $3, ";", geta($1), "d1+" ,$3, ":" ,geta($1));
339 | INCR LETTER '[' e ']'
341 bundle(7, $4, ";", geta($2), "1+d", $4, ":", geta($2));
343 | LETTER '[' e ']' DECR
345 bundle(7, $3, ";", geta($1), "d1-", $3, ":", geta($1));
347 | DECR LETTER '[' e ']'
349 bundle(7, $4, ";", geta($2), "1-d", $4, ":" ,geta($2));
351 | SCALE INCR
353 bundle(1, "Kd1+k");
355 | INCR SCALE
357 bundle(1, "K1+dk");
359 | SCALE DECR
361 bundle(1, "Kd1-k");
363 | DECR SCALE
365 bundle(1, "K1-dk");
367 | BASE INCR
369 bundle(1, "Id1+i");
371 | INCR BASE
373 bundle(1, "I1+di");
375 | BASE DECR
377 bundle(1, "Id1-i");
379 | DECR BASE
381 bundle(1, "I1-di");
383 | OBASE INCR
385 bundle(1, "Od1+o");
387 | INCR OBASE
389 bundle(1, "O1+do");
391 | OBASE DECR
393 bundle(1, "Od1-o");
395 | DECR OBASE
397 bundle(1, "O1-do");
399 | LETTER '(' cargs ')'
401 bundle(4, $3, "l", getf($1), "x");
403 | LETTER '(' ')'
405 bundle(3, "l", getf($1), "x");
407 | LETTER = {
408 bundle(2, "l", $1);
410 | LENGTH '(' e ')'
412 bundle(2, $3, "Z");
414 | SCALE '(' e ')'
416 bundle(2, $3, "X");
418 | '?'
420 bundle(1, "?");
422 | SQRT '(' e ')'
424 bundle(2, $3, "v");
426 | '~' LETTER
428 bundle(2, "L", $2);
430 | SCALE
432 bundle(1, "K");
434 | BASE
436 bundle(1, "I");
438 | OBASE
440 bundle(1, "O");
442 | '-' e
444 bundle(3, " 0", $2, "-");
446 | e '+' e
448 bundle(3, $1, $3, "+");
450 | e '-' e
452 bundle(3, $1, $3, "-");
454 | e '*' e
456 bundle(3, $1, $3, "*");
458 | e '/' e
460 bundle(3, $1, $3, "/");
462 | e '%' e
464 bundle(3, $1, $3, "%%");
466 | e '^' e
468 bundle(3, $1, $3, "^");
471 ase:
472 LETTER '=' e
474 bundle(3, $3, "ds", $1);
476 | LETTER '[' e ']' '=' e
478 bundle(5, $6, "d", $3, ":", geta($1));
480 | LETTER EQOP e
482 bundle(6, "l", $1, $3, $2, "ds", $1);
484 | LETTER '[' e ']' EQOP e
486 bundle(9, $3, ";", geta($1), $6, $5, "d", $3, ":", geta($1));
489 e:
490 ase
491 | nase
493 cargs:
494 eora
495 | cargs ',' eora
497 bundle(2, $1, $3);
500 eora:
502 | LETTER '[' ']'
504 bundle(2, "l", geta($1));
507 cons:
508 constant
510 *cp++ = 0;
513 constant:
514 '_'
516 $<cptr>$ = cp;
517 *cp++ = '_';
519 | DIGIT
521 $<cptr>$ = cp;
522 *cp++ = $1;
524 | constant DIGIT
526 *cp++ = $2;
529 crs:
532 $$ = cp;
533 *cp++ = '<';
534 *cp++ = crs/100+'0';
535 *cp++ = (crs%100)/10+'0';
536 *cp++ = crs%10+'0';
537 *cp++ = '>';
538 *cp++ = '\0';
539 if(crs++ >= 220) {
540 yyerror("program too big");
541 getout();
543 bstack[bindx++] = lev++;
546 def:
547 _DEFINE LETTER '('
549 $$ = getf($2);
550 pre = (char*)"";
551 post = (char*)"";
552 lev = 1;
553 bindx = 0;
554 bstack[bindx] = 0;
557 dargs:
558 | lora
560 pp((char*)$1);
562 | dargs ',' lora
564 pp((char*)$3);
567 dlets:
568 lora
570 tp((char*)$1);
572 | dlets ',' lora
574 tp((char*)$3);
577 lora:
578 LETTER
580 $<cptr>$=$1;
582 | LETTER '[' ']'
584 $$ = geta($1);
587 %%
589 int
590 yylex(void)
592 int c, ch;
594 restart:
595 c = getch();
596 peekc = -1;
597 while(c == ' ' || c == '\t')
598 c = getch();
599 if(c == '\\') {
600 getch();
601 goto restart;
603 if(c >= 'a' && c <= 'z') {
604 /* look ahead to look for reserved words */
605 peekc = getch();
606 if(peekc >= 'a' && peekc <= 'z') { /* must be reserved word */
607 if(c=='p' && peekc=='r') {
608 c = _PRINT;
609 goto skip;
611 if(c=='i' && peekc=='f') {
612 c = _IF;
613 goto skip;
615 if(c=='w' && peekc=='h') {
616 c = _WHILE;
617 goto skip;
619 if(c=='f' && peekc=='o') {
620 c = _FOR;
621 goto skip;
623 if(c=='s' && peekc=='q') {
624 c = SQRT;
625 goto skip;
627 if(c=='r' && peekc=='e') {
628 c = _RETURN;
629 goto skip;
631 if(c=='b' && peekc=='r') {
632 c = _BREAK;
633 goto skip;
635 if(c=='d' && peekc=='e') {
636 c = _DEFINE;
637 goto skip;
639 if(c=='s' && peekc=='c') {
640 c = SCALE;
641 goto skip;
643 if(c=='b' && peekc=='a') {
644 c = BASE;
645 goto skip;
647 if(c=='i' && peekc=='b') {
648 c = BASE;
649 goto skip;
651 if(c=='o' && peekc=='b') {
652 c = OBASE;
653 goto skip;
655 if(c=='d' && peekc=='i') {
656 c = FFF;
657 goto skip;
659 if(c=='a' && peekc=='u') {
660 c = _AUTO;
661 goto skip;
663 if(c=='l' && peekc=='e') {
664 c = LENGTH;
665 goto skip;
667 if(c=='q' && peekc=='u')
668 getout();
669 /* could not be found */
670 return ERROR;
672 skip: /* skip over rest of word */
673 peekc = -1;
674 for(;;) {
675 ch = getch();
676 if(ch < 'a' || ch > 'z')
677 break;
679 peekc = ch;
680 return c;
683 /* usual case; just one single letter */
684 yylval.cptr = letr[c-'a'];
685 return LETTER;
687 if((c >= '0' && c <= '9') || (c >= 'A' && c <= 'F')) {
688 yylval.cc = c;
689 return DIGIT;
691 switch(c) {
692 case '.':
693 return DOT;
694 case '*':
695 yylval.cptr = "*";
696 return cpeek('=', EQOP, c);
697 case '%':
698 yylval.cptr = "%%";
699 return cpeek('=', EQOP, c);
700 case '^':
701 yylval.cptr = "^";
702 return cpeek('=', EQOP, c);
703 case '+':
704 ch = cpeek('=', EQOP, c);
705 if(ch == EQOP) {
706 yylval.cptr = "+";
707 return ch;
709 return cpeek('+', INCR, c);
710 case '-':
711 ch = cpeek('=', EQOP, c);
712 if(ch == EQOP) {
713 yylval.cptr = "-";
714 return ch;
716 return cpeek('-', DECR, c);
717 case '=':
718 return cpeek('=', EQ, '=');
719 case '<':
720 return cpeek('=', LE, '<');
721 case '>':
722 return cpeek('=', GE, '>');
723 case '!':
724 return cpeek('=', NE, '!');
725 case '/':
726 ch = cpeek('=', EQOP, c);
727 if(ch == EQOP) {
728 yylval.cptr = "/";
729 return ch;
731 if(peekc == '*') {
732 peekc = -1;
733 for(;;) {
734 ch = getch();
735 if(ch == '*') {
736 peekc = getch();
737 if(peekc == '/') {
738 peekc = -1;
739 goto restart;
744 return c;
745 case '"':
746 yylval.cptr = str;
747 while((c=getch()) != '"'){
748 *str++ = c;
749 if(str >= &string[999]){
750 yyerror("string space exceeded");
751 getout();
754 *str++ = 0;
755 return QSTR;
756 default:
757 return c;
761 int
762 cpeek(int c, int yes, int no)
765 peekc = getch();
766 if(peekc == c) {
767 peekc = -1;
768 return yes;
770 return no;
773 int
774 getch(void)
776 long ch;
778 loop:
779 ch = peekc;
780 if(ch < 0){
781 if(in == 0)
782 ch = -1;
783 else
784 ch = Bgetc(in);
786 peekc = -1;
787 if(ch >= 0)
788 return ch;
789 ifile++;
790 if(ifile > sargc) {
791 if(ifile >= sargc+2)
792 getout();
793 in = &bstdin;
794 Binit(in, 0, OREAD);
795 ln = 0;
796 goto loop;
798 if(in)
799 Bterm(in);
800 if((in = Bopen(sargv[ifile], OREAD)) != 0){
801 ln = 0;
802 ss = sargv[ifile];
803 goto loop;
805 yyerror("cannot open input file");
806 return 0; /* shut up ken */
809 char*
810 bundle(int a, ...)
812 int i;
813 char **q;
814 va_list arg;
816 i = a;
817 va_start(arg, a);
818 q = bsp_nxt;
819 if(bdebug)
820 fprint(2, "bundle %d elements at %lx\n", i, q);
821 while(i-- > 0) {
822 if(bsp_nxt >= &bspace[bsp_max])
823 yyerror("bundling space exceeded");
824 *bsp_nxt++ = va_arg(arg, char*);
826 *bsp_nxt++ = 0;
827 va_end(arg);
828 yyval.cptr = (char*)q;
829 return (char*)q;
832 void
833 routput(char *p)
835 char **pp;
837 if(bdebug)
838 fprint(2, "routput(%lx)\n", p);
839 if((char**)p >= &bspace[0] && (char**)p < &bspace[bsp_max]) {
840 /* part of a bundle */
841 pp = (char**)p;
842 while(*pp != 0)
843 routput(*pp++);
844 } else
845 Bprint(&bstdout, p); /* character string */
848 void
849 output(char *p)
851 routput(p);
852 bsp_nxt = &bspace[0];
853 Bprint(&bstdout, "\n");
854 Bflush(&bstdout);
855 cp = cary;
856 crs = rcrs;
859 void
860 conout(char *p, char *s)
862 Bprint(&bstdout, "[");
863 routput(p);
864 Bprint(&bstdout, "]s%s\n", s);
865 Bflush(&bstdout);
866 lev--;
869 void
870 yyerror(char *s, ...)
872 if(ifile > sargc)
873 ss = "teletype";
874 Bprint(&bstdout, "c[%s on line %d, %s]pc\n", s, ln+1, ss);
875 Bflush(&bstdout);
876 cp = cary;
877 crs = rcrs;
878 bindx = 0;
879 lev = 0;
880 bsp_nxt = &bspace[0];
883 void
884 pp(char *s)
886 /* puts the relevant stuff on pre and post for the letter s */
887 bundle(3, "S", s, pre);
888 pre = yyval.cptr;
889 bundle(4, post, "L", s, "s.");
890 post = yyval.cptr;
893 void
894 tp(char *s)
896 /* same as pp, but for temps */
897 bundle(3, "0S", s, pre);
898 pre = yyval.cptr;
899 bundle(4, post, "L", s, "s.");
900 post = yyval.cptr;
903 void
904 yyinit(int argc, char **argv)
906 Binit(&bstdout, 1, OWRITE);
907 sargv = argv;
908 sargc = argc - 1;
909 if(sargc == 0) {
910 in = &bstdin;
911 Binit(in, 0, OREAD);
912 } else if((in = Bopen(sargv[1], OREAD)) == 0)
913 yyerror("cannot open input file");
914 ifile = 1;
915 ln = 0;
916 ss = sargv[1];
919 void
920 getout(void)
922 Bprint(&bstdout, "q");
923 Bflush(&bstdout);
924 exits(0);
927 char*
928 getf(char *p)
930 return funtab[*p - 'a'];
933 char*
934 geta(char *p)
936 return atab[*p - 'a'];
939 void
940 main(int argc, char **argv)
942 int p[2];
944 while(argc > 1 && *argv[1] == '-') {
945 switch(argv[1][1]) {
946 case 'd':
947 bdebug++;
948 break;
949 case 'c':
950 cflag++;
951 break;
952 case 'l':
953 lflag++;
954 break;
955 case 's':
956 sflag++;
957 break;
958 default:
959 fprint(2, "Usage: bc [-l] [-c] [file ...]\n");
960 exits("usage");
962 argc--;
963 argv++;
965 if(lflag) {
966 argv--;
967 argc++;
968 argv[1] = unsharp("#9/lib/bclib");
970 if(cflag) {
971 yyinit(argc, argv);
972 for(;;)
973 yyparse();
974 exits(0);
976 pipe(p);
977 if(fork() == 0) {
978 dup(p[1], 1);
979 close(p[0]);
980 close(p[1]);
981 yyinit(argc, argv);
982 for(;;)
983 yyparse();
985 dup(p[0], 0);
986 close(p[0]);
987 close(p[1]);
988 execl("dc", "dc", nil);