/* bbvars - emit definition for basic block counting data */ static void bbvars(Symbol yylink) { int i, j, n = npoints; Value v; struct map** mp; Symbol coords, files, *p; if (!YYcounts && !yylink) return; if (YYcounts) { if (n <= 0) n = 1; YYcounts->type = array(unsignedtype, n, 0); defglobal(YYcounts, BSS); } files = genident(STATIC, array(charptype, 1, 0), GLOBAL); defglobal(files, LIT); for (p = ltov(&filelist, PERM); *p; p++) defpointer((*p)->u.c.loc); defpointer(NULL); coords = genident(STATIC, array(unsignedtype, n, 0), GLOBAL); defglobal(coords, LIT); for (i = n, mp = ltov(&maplist, PERM); *mp; i -= (*mp)->size, mp++) for (j = 0; j < (*mp)->size; j++) (*IR->defconst)(U, unsignedtype->size, (v.u = (*mp)->u[j].coord, v)); if (i > 0) (*IR->space)(i * coords->type->type->size); defpointer(NULL); defglobal(yylink, DATA); defpointer(NULL); (*IR->defconst)(U, unsignedtype->size, (v.u = n, v)); defpointer(YYcounts); defpointer(coords); defpointer(files); defpointer(funclist); }
/* stabend - emits the symbol table */ static void stabend(Coordinate *cp, Symbol symroot, Coordinate *cpp[], Symbol sp[], Symbol *ignore) { Symbol addresses; int naddresses, nmodule; { /* annotate top-level symbols */ Symbol p; for (p = symroot; p != NULL; p = up(p->up)) symboluid(p); pickle->globals = symboluid(symroot); } { /* emit addresses of top-level and static symbols */ int i, lc = 0, count = Seq_length(statics); addresses = genident(STATIC, array(voidptype, 1, 0), GLOBAL); comment("addresses:\n"); defglobal(addresses, LIT); for (i = 0; i < count; i++) { Symbol p = Seq_get(statics, i); lc = emit_value(lc, voidptype, p); } lc = pad(maxalign, lc); naddresses = lc; Seq_free(&statics); } { /* emit bp count as an alias for the module */ Symbol spoints = mksymbol(AUTO, stringf("_spoints_V%x_%d", uname, Seq_length(pickle->spoints)), array(unsignedtype, 0, 0)); spoints->generated = 1; defglobal(spoints, LIT); } { /* emit module */ int lc; comment("module:\n"); defglobal(module, LIT); lc = emit_value( 0, unsignedtype, (unsigned long)uname); lc = emit_value(lc, voidptype, addresses); lc = pad(maxalign, lc); nmodule = lc; } Seq_free(&locals); #define printit(x) fprintf(stderr, "%7d " #x "\n", n##x); total += n##x { int total = 0; printit(addresses); printit(module); fprintf(stderr, "%7d bytes total\n", total); } #undef printit { /* complete and write symbol-table pickle */ FILE *f = fopen(stringf("%d.pickle", uname), "wb"); sym_write_module(pickle, f); fclose(f); } }
int main() { Value *result; init(); // List manipulation. defnative(mksym("CONS"), native_cons); defnative(mksym("CAR"), native_car); defnative(mksym("CDR"), native_cdr); // Arithmetic. defnative(mksym("PLUS"), native_plus); defnative(mksym("MINUS"), native_minus); defnative(mksym("MUL"), native_mul); defnative(mksym("DIV"), native_div); // Miscellaneous. defnative(mksym("EVAL"), native_eval); defglobal(mksym("NIL"), LISP_NIL); while (!feof(stdin)) { setjmp(toplevel_escape); printf("> "); result = eval(lread(), global_env); printf("\n"); lwrite(result); printf("\n"); } return 0; }
Value *eval_define(Value *form, Value *env) { Value *name = CADR(form); Value *value = eval(CADDR(form), env); defglobal(name, value); return name; }
/* bbcall - build tree to set _callsite at call site *cp, emit call site data */ static void bbcall(Symbol yycounts, Coordinate* cp, Tree* e) { static Symbol caller; Value v; union coordinate u; Symbol p = genident(STATIC, array(voidptype, 0, 0), GLOBAL); Tree t = *e; defglobal(p, LIT); defpointer(cp->file ? mkstr(cp->file)->u.c.loc : (Symbol)0); defpointer(mkstr(cfunc->name)->u.c.loc); if (IR->little_endian) { u.le.x = cp->x; u.le.y = cp->y; } else { u.be.x = cp->x; u.be.y = cp->y; } (*IR->defconst)(U, unsignedtype->size, (v.u = u.coord, v)); if (caller == 0) { caller = mksymbol(EXTERN, "_caller", ptr(voidptype)); caller->defined = 0; } if (generic((*e)->op) != CALL) t = (*e)->kids[0]; assert(generic(t->op) == CALL); t = tree(t->op, t->type, tree(RIGHT, t->kids[0]->type, t->kids[0], tree(RIGHT, t->kids[0]->type, asgn(caller, idtree(p)), t->kids[0])), t->kids[1]); if (generic((*e)->op) != CALL) t = tree((*e)->op, (*e)->type, t, (*e)->kids[1]); *e = t; }
/* bbfunc - emit function name and src coordinates */ static void bbfunc(Symbol yylink, Symbol f) { Value v; union coordinate u; defglobal(afunc, DATA); defpointer(funclist); defpointer(NULL); defpointer(mkstr(f->name)->u.c.loc); if (IR->little_endian) { u.le.x = f->u.f.pt.x; u.le.y = f->u.f.pt.y; u.le.index = bbfile(f->u.f.pt.file); } else { u.be.x = f->u.f.pt.x; u.be.y = f->u.f.pt.y; u.be.index = bbfile(f->u.f.pt.file); } (*IR->defconst)(U, unsignedtype->size, (v.u = u.coord, v)); funclist = afunc; }
/* tracecall - generate code to trace entry to f */ static void tracecall(Symbol printer, Symbol f, void *ignore) { int i; Symbol counter = genident(STATIC, inttype, GLOBAL); defglobal(counter, BSS); (*IR->space)(counter->type->size); frameno = genident(AUTO, inttype, level); addlocal(frameno); appendstr(f->name); appendstr("#"); tracevalue(asgn(frameno, incr(INCR, idtree(counter), consttree(1, inttype))), 0); appendstr("("); for (i = 0; f->u.f.callee[i]; i++) { if (i) appendstr(","); appendstr(f->u.f.callee[i]->name); appendstr("="); tracevalue(idtree(f->u.f.callee[i]), 0); } if (variadic(f->type)) appendstr(",..."); appendstr(") called\n"); tracefinis(printer); }
void defnative(Value *name, Value* (*fn)(Value *)) { defglobal(name, mknative(fn)); }
T eval_defun(T form, Environment env) { Object name = CADR(form); Object value = mklambda(CADDR(form), CADDDR(form), env); defglobal(name, value); return name; }