8 typedef struct Sym Sym;
9 typedef struct Node Node;
35 #pragma varargck type "N" Node*
41 Node* new(int, Node*, Node*);
54 void diag(Node*, char*, ...);
56 void fcom(Node*,Node*,Node*);
58 #pragma varargck argpos cprint 1
59 #pragma varargck argpos diag 2
69 %type <node> name num args expr bool block elif stmnt stmnts
82 %token MOD IF ELSE WHILE BREAK
83 %token <sval> NAME NUM
110 $$ = new(NAME,nil,nil);
116 $$ = new(NUM,nil,nil);
121 ELSE IF '(' bool ')' stmnt
123 $$ = new('?', $4, new(':', $6, nil));
125 | ELSE IF '(' bool ')' stmnt elif
127 $$ = new('?', $4, new(':', $6, $7));
141 $$ = new('=', $1, $3);
145 $$ = new('m', $2, $3);
147 | IF '(' bool ')' stmnt
149 $$ = new('?', $3, new(':', $5, nil));
151 | IF '(' bool ')' stmnt elif
153 $$ = new('?', $3, new(':', $5, $6));
155 | WHILE '(' bool ')' stmnt
157 $$ = new('@', new('?', $3, new(':', $5, new('b', nil, nil))), nil);
161 $$ = new('b', nil, nil);
166 $$ = new('e', $1, nil);
181 $$ = new('\n', $1, $2);
200 $$ = new(NUM, nil, nil);
203 $$ = new('-', $$, $2);
207 $$ = new(',', $1, $3);
211 $$ = new('^', $1, $3);
215 $$ = new('*', $1, $3);
219 $$ = new('/', $1, $3);
223 $$ = new('%', $1, $3);
227 $$ = new('+', $1, $3);
231 $$ = new('-', $1, $3);
233 | bool '?' expr ':' expr
235 $$ = new('?', $1, new(':', $3, $5));
239 $$ = new('e', $1, $2);
243 $$ = new(LSH, $1, $3);
247 $$ = new(RSH, $1, $3);
257 $$ = new('!', $2, nil);
261 $$ = new(EQ, $1, $3);
265 $$ = new('!', new(EQ, $1, $3), nil);
269 $$ = new('>', $1, $3);
273 $$ = new('<', $1, $3);
281 static char buf[200];
295 while((c = getch()) > 0)
311 if(getch() == '<') return LSH;
315 if(getch() == '>') return RSH;
319 if(getch() == '=') return EQ;
323 if(getch() == '=') return NEQ;
334 || (c >= 'a' && c <= 'z')
335 || (c >= 'A' && c <= 'Z')
336 || (c >= '0' && c <= '9')){
345 if(strcmp(buf, "mod") == 0)
347 if(strcmp(buf, "if") == 0)
349 if(strcmp(buf, "else") == 0)
351 if(strcmp(buf, "while") == 0)
353 if(strcmp(buf, "break") == 0)
356 yylval.sval = sym(buf);
358 return (buf[0] >= '0' && buf[0] <= '9') ? NUM : NAME;
384 new(int c, Node *l, Node *r)
388 n = malloc(sizeof(Node));
401 static Sym *tab[128];
407 for(i=0; n[i] != '\0'; i++){
414 for(s = tab[h]; s != nil; s = s->l)
415 if(strcmp(s->n, n) == 0)
417 s = malloc(sizeof(Sym)+i+1);
418 memmove(s->n, n, i+1);
428 fprint(2, "%s:%d: %s\n", filename, lineno, s);
432 cprint(char *fmt, ...)
434 static char buf[1024], tabs[] = "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t";
439 vsnprint(buf, sizeof(buf), fmt, a);
443 while((x = strchr(p, '\n')) != nil){
446 p = &tabs[sizeof(tabs)-1 - clevel];
448 write(1, p, strlen(p));
452 write(1, p, strlen(p));
466 snprint(n, sizeof(n), "tmp%d", ++ntmp);
467 t = new(NAME, nil, nil);
472 cprint("%N = mpnew(0);\n", t);
473 t->s->f &= ~(FSET|FUSE);
485 return n->s == sym("mpzero") ||
486 n->s == sym("mpone") ||
487 n->s == sym("mptwo");
498 for(l = atmps; l != nil; l = l->l){
523 for(l = atmps; l != nil; l = l->l){
525 cprint("mpfree(%N);\n", t);
536 symref(Node *n, Sym *s)
540 if(n->c == NAME && n->s == s)
542 return symref(n->l, s) || symref(n->r, s);
565 if(n->c == NUM && n->m->sign > 0 && mpcmp(n->m, mptwo) <= 0)
571 bcom(Node *n, Node *t);
587 f->m = strtomp(f->s->n, nil, 0, nil);
589 diag(f, "bad constant");
602 if(modulo == nil || modulo->c == NUM)
610 f->l = l = ccom(f->l);
611 f->r = r = ccom(f->r);
612 if(l == nil || r == nil || l->c != NUM || r->c != NUM)
619 if(mpsignif(r->m) > 32)
620 diag(f, "bad shift");
622 mpleft(l->m, mptoi(r->m), f->m);
624 mpright(l->m, mptoi(r->m), f->m);
628 mpadd(l->m, r->m, f->m);
631 mpsub(l->m, r->m, f->m);
634 mpmul(l->m, r->m, f->m);
638 mpinvert(r->m, modulo->m, f->m);
639 mpmul(f->m, l->m, f->m);
641 mpdiv(l->m, r->m, f->m, nil);
645 mpmod(l->m, r->m, f->m);
648 mpexp(l->m, r->m, modulo != nil ? modulo->m : nil, f->m);
652 mpmod(f->m, modulo->m, f->m);
663 ecom(Node *f, Node *t)
677 t = ecom(t, alloctmp());
678 cprint("%N->sign = -1;\n", t);
681 if(mpcmp(f->m, mpzero) == 0){
683 f->s = sym("mpzero");
687 if(mpcmp(f->m, mpone) == 0){
693 if(mpcmp(f->m, mptwo) == 0){
703 diag(f, "cannot assign list to %N", t);
704 f->l = ecom(f->l, nil);
705 f->r = ecom(f->r, nil);
711 if((f->s->f & FSET) == 0)
712 diag(f, "name used but not set");
717 cprint("mpassign(%N, %N);\n", f, t);
732 cprint("%N(%N);\n", f->l, t);
734 cprint("%N(%N, %N);\n", f->l, r, t);
739 diag(f, "destination %N not a name", t);
743 if(mpsignif(f->m) <= 32)
744 cprint("uitomp(%udUL, %N);\n", mptoui(f->m), t);
745 else if(mpsignif(f->m) <= 64)
746 cprint("uvtomp(%lludULL, %N);\n", mptouv(f->m), t);
748 cprint("strtomp(\"%.16B\", nil, 16, %N);\n", f->m, t);
753 if(r == nil || r->c != NUM || mpsignif(r->m) > 32)
754 diag(f, "bad shift");
755 l = f->l->c == NAME ? f->l : ecom(f->l, t);
757 cprint("mpleft(%N, %d, %N);\n", l, mptoi(r->m), t);
759 cprint("mpright(%N, %d, %N);\n", l, mptoi(r->m), t);
769 l = ecom(l, complex(l) && !symref(r, t->s) ? t : nil);
770 r = ecom(r, complex(r) && l->s != t->s ? t : nil);
778 cprint("mpmodadd(%N, %N, %N, %N);\n", l, r, modulo, t);
781 cprint("mpmodsub(%N, %N, %N, %N);\n", l, r, modulo, t);
785 if(l->s == sym("mptwo") || r->s == sym("mptwo"))
786 cprint("mpmodadd(%N, %N, %N, %N); // 2*%N\n",
787 r->s == sym("mptwo") ? l : r,
788 r->s == sym("mptwo") ? l : r,
792 cprint("mpmodmul(%N, %N, %N, %N);\n", l, r, modulo, t);
795 if(l->s == sym("mpone")){
796 cprint("mpinvert(%N, %N, %N);\n", r, modulo, t);
800 cprint("mpinvert(%N, %N, %N);\n", r, modulo, t2);
801 cprint("mpmodmul(%N, %N, %N, %N);\n", l, t2, modulo, t);
805 if(r->s == sym("mptwo")){
809 cprint("mpexp(%N, %N, %N, %N);\n", l, r, modulo, t);
816 cprint("mpadd(%N, %N, %N);\n", l, r, t);
819 if(l->s == sym("mpzero")){
821 cprint("%N->sign = -%N->sign;\n", t, t);
823 cprint("mpsub(%N, %N, %N);\n", l, r, t);
827 if(l->s == sym("mptwo") || r->s == sym("mptwo"))
828 cprint("mpleft(%N, 1, %N);\n", r->s == sym("mptwo") ? l : r, t);
830 cprint("mpmul(%N, %N, %N);\n", l, r, t);
833 cprint("mpdiv(%N, %N, %N, %N);\n", l, r, t, nil);
836 cprint("mpmod(%N, %N, %N);\n", l, r, t);
839 if(r->s == sym("mptwo")){
843 cprint("mpexp(%N, %N, nil, %N);\n", l, r, t);
846 diag(f, "unknown operation");
859 bcom(Node *n, Node *t)
880 b1 = ecom(n->r->l, nil);
881 b2 = ecom(n->r->r, nil);
889 cprint("mpcmp(%N, %N)", l, r);
894 cprint(" >> (sizeof(int)*8-1)");
896 cprint(", %N, %N, %N);\n", neg ? b2 : b1, neg ? b1 : b2, t);
905 cprint("mpcmp(%N, %N)", l, r);
907 cprint(neg ? " != 0" : " == 0");
909 cprint(neg ? " <= 0" : " > 0");
911 cprint(neg ? " >= 0" : " < 0");
918 diag(n, "saw %N in boolean expression", f);
940 for(l = atmps; l != nil; l = l->l)
941 cprint("mpfree(%N);\n", l);
967 modulo = ecom(n->l, nil);
974 cprint("%N();\n", n->l);
977 cprint("%N(%N);\n", n->l, r);
988 flocs(Node *n, Node *r)
1001 diag(n, "lhs is nil");
1010 if(n->c == NAME && (n->s->f & (FARG|FLOC)) == 0){
1012 return new(',', n, r);
1020 fcom(Node *f, Node *a, Node *b)
1025 ftmps = atmps = modulo = nil;
1027 cprint("void %N(", f);
1032 l = a->c == NAME ? a : a->l;
1033 l->s->f = FARG|FSET;
1034 cprint("mpint *%N", l);
1039 for(a = l0; a != nil; a = a->r)
1040 cprint("mpint *%N = mpnew(0);\n", a->l);
1042 for(a = l0; a != nil; a = a->r)
1043 cprint("mpfree(%N);\n", a->l);
1049 diag(Node *n, char *fmt, ...)
1051 static char buf[1024];
1055 vsnprint(buf, sizeof(buf), fmt, a);
1058 fprint(2, "%s:%d: for %N; %s\n", filename, n->n, n, buf);
1065 Node *n = va_arg(f->args, Node*);
1068 return fmtprint(f, "nil");
1071 return fmtprint(f, "%N, %N", n->l, n->r);
1076 return fmtprint(f, "%B", n->m);
1079 return fmtprint(f, "%s", n->s->n);
1081 return fmtprint(f, "==");
1083 return fmtprint(f, "if");
1085 return fmtprint(f, "else");
1087 return fmtprint(f, "mod");
1089 return fmtprint(f, "%c", (char)n->c);
1094 parse(int fd, char *file)
1096 Binit(&bin, fd, OREAD);
1109 fprint(2, "%s [file ...]\n", argv0);
1114 main(int argc, char *argv[])
1116 fmtinstall('N', Nfmt);
1117 fmtinstall('B', mpfmt);
1125 parse(0, "<stdin>");
1128 while(*argv != nil){
1131 if((fd = open(*argv, OREAD)) < 0){
1132 fprint(2, "%s: %r\n", *argv);