diff options
| -rw-r--r-- | pez.c | 501 | ||||
| -rw-r--r-- | pez.h | 4 | ||||
| -rw-r--r-- | repl.c | 3 | ||||
| -rw-r--r-- | test.pez | 2 |
4 files changed, 352 insertions, 158 deletions
@@ -36,47 +36,64 @@ typedef struct Val { } typedef struct Obj Obj; +#define OBJHEADER Obj *next; short t : 8, gc : 1; + struct Obj { - Obj *prev, *next; - short t; + OBJHEADER; }; typedef struct Str { - Obj o; + OBJHEADER; uint n; char dat[]; } Str; typedef struct Tuple { - Obj o; - uint len; + uint8_t len; Val dat[]; } Tuple; typedef struct Array { - Obj o; + OBJHEADER; vec_of(Val); } Array; struct KV { Val k, v; }; typedef struct Record { - Obj o; - uint count, N; + OBJHEADER; + uint8_t exp; + uint count; struct KV dat[]; } Record; -typedef struct Fn { - Obj o; +typedef struct Proto { + OBJHEADER; + short variadic : 1, + named : 1; + short nvars, nparams; + uint ncode, ncon; + int linebegin, lineend; const char *file; const uint8_t *code; const Val *con; - int linebegin; - uint ncode, ncon; - short nvars, nparams; - bool variadic : 1; - bool named : 1; char name[]; +} Proto; + + +typedef struct Upval Upval; +struct Upval { + OBJHEADER; + Upval *nextup; + Val *ptr; + Val slot; +}; + +typedef struct Fn { + OBJHEADER; + short nupval; + Proto *proto; + Upval *upval[]; } Fn; typedef struct Local Local; @@ -96,7 +113,7 @@ typedef struct Comp { char stash_binopchr; int stash_binopop; - Fn *fn; + Proto *proto; vec_of(uint8_t) code; vec_of(Val) con; @@ -151,7 +168,8 @@ struct PezContext { PezError err; char errstr[140]; Val *stack, *stktop, *stkend; - Obj *heap, tmpheap; + Obj *heap; + int nalloc, gcthresh, gccanrun : 1; StrPool strpool; Globals globals; }; @@ -181,10 +199,10 @@ enum { #define sstr_len(v) (((v).r & 0xFF) >> 4) #define iscfn(v) (((v).r & 3) == TAGCFn) #define unbox_num(v) ((fixnum)((v).r >> 32)) -#define unbox_obj(v) ((Obj *)(intptr_t)(v).r) +#define unbox_obj(v) ((void *)(intptr_t)(v).r) #define unbox_bool(v) ((bool)((v).r >> 32)) #define unbox_cfn(v) ((PezCFn *)((intptr_t)(v).r >> 2)) -#define objtag(v) (unbox_obj(v)->t) +#define objtag(v) (((Obj *)unbox_obj(v))->t) #define isobj_of(v, tag) (isobj(v) && objtag(v) == (tag)) #define box_obj(x) ((Val){(intptr_t)(x)}) #define box_num(x) ((Val){(uint64_t)(x) << 32 | TAGNum}) @@ -201,11 +219,12 @@ typestr(Val v) return "void"; if (isobj(v)) { switch (objtag(v)) { - case PEZ_TString: return "string"; - case PEZ_TTuple: return "tuple"; - case PEZ_TRecord: return "record"; - case PEZ_TArray: return "array"; - case PEZ_TFn: return "function"; + case PEZ_TString: return "string"; + case PEZ_TTuple: return "tuple"; + case PEZ_TRecord: return "record"; + case PEZ_TArray: return "array"; + case PEZ_TFn: return "function"; + case PEZ_TFnProto: return "(function prototype)"; } } if (isnum(v)) @@ -241,16 +260,31 @@ unbox_sstr(Val v, char buf[8]) #define TRY(x) do { if (!(x)) return 0; } while (0) #define ETRY(x) do { if (!(x)) goto Err; } while (0) +static void gc(PezContext *cx); + static void * +cxrealloc(PezContext *cx, void *p, size_t osz, size_t sz) +{ + void *a = cx->alloc(cx->ud, p, osz, sz); + if (a || !p) { + cx->nalloc += sz - osz; + assert(cx->nalloc >= 0); + if (sz > osz && cx->gccanrun) { gc(cx); }; + } + return a; +} + + +static inline void * cxalloc(PezContext *cx, size_t sz) { - return cx->alloc(cx->ud, NULL, 0, sz); + return cxrealloc(cx, NULL, 0, sz); } -static void +static inline void cxfree(PezContext *cx, void *p, size_t sz) { - cx->alloc(cx->ud, p, sz, 0); + cxrealloc(cx, p, sz, 0); } #define delvec(cx, v) \ @@ -275,7 +309,7 @@ _vecpush(PezContext *cx, void **at, size_t sz, uint newcap = (*len + n) * 2; uint8_t *new; newcap = newcap < 4 ? 4 : newcap; - new = cx->alloc(cx->ud, *at, *cap * sz, newcap * sz); + new = cxrealloc(cx, *at, *cap * sz, newcap * sz); if (!new) { if (*at) { cxfree(cx, *at, *cap * sz); @@ -303,7 +337,7 @@ _vecpop(PezContext *cx, void **at, size_t sz, if (*len < *cap / 4) { uint newcap = *cap / 2; uint8_t *new; - new = cx->alloc(cx->ud, *at, *cap * sz, newcap * sz); + new = cxrealloc(cx, *at, *cap * sz, newcap * sz); if (new) { *at = new; *cap = newcap; @@ -312,7 +346,7 @@ _vecpop(PezContext *cx, void **at, size_t sz, } */ -static Obj * +static void * newobj(PezContext *cx, int type, size_t sz) { Obj *o = cxalloc(cx, sz); @@ -322,30 +356,11 @@ newobj(PezContext *cx, int type, size_t sz) } memset(o, 0, sz); o->next = cx->heap; - if (cx->heap) { - cx->heap->prev = o; - } cx->heap = o; o->t = type; return o; } -static void delfn(PezContext *, Fn *); -static void delarray(PezContext *, Array *); -static void -freeobj(PezContext *cx, Obj *o) -{ - switch (o->t) { - case PEZ_TFn: - delfn(cx, (Fn *)o); - break; - case PEZ_TArray: - delarray(cx, (Array *)o); - break; - } - cxfree(cx, o, sizeof *o); -} - static inline bool FORCEINLINE push(PezContext *cx, Val v) { @@ -397,29 +412,41 @@ splittable64(uint64_t x) /* Objects */ /***********/ -static Fn * -newfn(PezContext *cx, const char *file, const char *name, int line) +static Proto * +newproto(PezContext *cx, const char *file, const char *name, int line) { - Fn *fn = (Fn *)newobj(cx, PEZ_TFn, sizeof *fn + (name ? strlen(name) + 1 : 0)); - if (fn) { - Obj hdr = fn->o; - memset(fn, 0, sizeof *fn); - fn->o = hdr; - fn->file = file; - fn->linebegin = line; + Proto *pr = newobj(cx, PEZ_TFnProto, sizeof *pr + (name ? strlen(name) + 1 : 0)); + if (pr) { + pr->file = file; + pr->linebegin = line; if (name) { - fn->named = 1; - strcpy(fn->name, name); + pr->named = 1; + strcpy(pr->name, name); } } + return pr; +} + +static void +delproto(PezContext *cx, Proto *pr) +{ + cxfree(cx, (void *)pr->code, pr->ncode); + cxfree(cx, (void *)pr->con, pr->ncon * sizeof(Val)); +} + +static Fn * +newfn(PezContext *cx, Proto *pr) +{ + Fn *fn = newobj(cx, PEZ_TFn, sizeof *fn); + if (fn) { + fn->proto = pr; + } return fn; } static void delfn(PezContext *cx, Fn *fn) { - cxfree(cx, (void *)fn->code, fn->ncode); - cxfree(cx, (void *)fn->con, fn->ncon * sizeof(Val)); } static Val * @@ -553,7 +580,7 @@ box_str(PezContext *cx, Val *pv, const char *s, int len) } TRY(slot = strpool_lookup(cx, s, len)); if (!*slot) { - Str *o = (Str *)newobj(cx, PEZ_TString, sizeof(Str) + len + 1); + Str *o = newobj(cx, PEZ_TString, sizeof(Str) + len + 1); if (!o) { return 0; } @@ -569,15 +596,18 @@ box_str(PezContext *cx, Val *pv, const char *s, int len) static Array * newarr(PezContext *cx, uint cap) { - Array *arr = (Array *)newobj(cx, PEZ_TArray, sizeof *arr); + Array *arr = newobj(cx, PEZ_TArray, sizeof *arr); if (!arr) { return NULL; } - arr->len = 0; - arr->cap = cap; - arr->at = NULL; if (cap) { + if (!push(cx, box_obj(arr))) { // gc keep + cxfree(cx, arr, sizeof *arr); + return NULL; + } arr->at = cxalloc(cx, cap * sizeof(Val)); + arr->cap = cap; + pop(cx); } return arr; } @@ -588,12 +618,137 @@ delarray(PezContext *cx, Array *arr) delvec(cx, arr); } +static void +delstring(PezContext *cx, Str *str) +{ + Str **slot = strpool_lookup(cx, str->dat, str->n); + assert(slot && *slot == str); + *slot = NULL; + ++cx->strpool.deleted; + --cx->strpool.count; +} + static bool arrpushn(PezContext *cx, Array *arr, Val *src, uint n) { return n == 0 ? 1 : vecpush(cx, arr, src, n); } +/******/ +/* GC */ +/******/ + +static void +freeobj(PezContext *cx, Obj *o) +{ + switch (o->t) { + case PEZ_TFn: + delfn(cx, (Fn *)o); + break; + case PEZ_TFnProto: + delproto(cx, (Proto *)o); + break; + case PEZ_TArray: + delarray(cx, (Array *)o); + break; + case PEZ_TString: + delstring(cx, (Str *)o); + break; + } + cxfree(cx, o, sizeof *o); +} + +static void gcmark(PezContext *cx, Obj *o); + +static void +markproto(PezContext *cx, Proto *pr) +{ + for (int i = 0; i < pr->ncon; ++i) { + if (isobj(pr->con[i])) { + gcmark(cx, unbox_obj(pr->con[i])); + } + } +} + +static void +markfn(PezContext *cx, Fn *fn) +{ + gcmark(cx, (Obj *)fn->proto); +} + +static void +markarray(PezContext *cx, Array *arr) +{ + for (int i = 0; i < arr->len; ++i) { + if (isobj(arr->at[i])) { + gcmark(cx, unbox_obj(arr->at[i])); + } + } +} + +static void +gcmark(PezContext *cx, Obj *o) +{ + if (o->gc) { + return; + } + // fprintf(stderr, "visit! %p %s\n", o, typestr(box_obj(o))); + o->gc = 1; + assert(o->next != o); + + switch (o->t) { + case PEZ_TFnProto: + markproto(cx, (Proto *)o); + break; + case PEZ_TFn: + markfn(cx, (Fn *)o); + break; + case PEZ_TArray: + markarray(cx, (Array *)o); + break; + } +} + +static void +gc(PezContext *cx) +{ + // fprintf(stderr, "GC\n---\n"); + for (Val *stk = cx->stack; stk != cx->stktop; ++stk) { + if (isobj(*stk)) { + gcmark(cx, unbox_obj(*stk)); + } + } + if (cx->globals.dat) { + for (int i = 0; i < cx->globals.N; ++i) { + struct KV *kv = &cx->globals.dat[i]; + if (!isvoid(kv->k)) { + if (isobj(kv->k)) { + gcmark(cx, unbox_obj(kv->k)); + } + if (isobj(kv->v)) { + gcmark(cx, unbox_obj(kv->v)); + } + } + } + } + for (Obj *o = cx->heap, *next, *prev = NULL; o; o = next) { + next = o->next; + if (o->gc) { + prev = o; + o->gc = 0; + } else { + // fprintf(stderr, "free %p %s\n", o, typestr(box_obj(o))); + if (o == cx->heap) { + cx->heap = next; + } + if (prev) { + prev->next = next; + } + freeobj(cx, o); + } + } +} + /********************/ /* Fixed point math */ /********************/ @@ -740,24 +895,24 @@ static const int8_t opeffects[] = { }; static void -vrunerr(PezContext *cx, void *fn_, int ip, const char *fmt, va_list ap) +vrunerr(PezContext *cx, void *fn, int ip, const char *fmt, va_list ap) { char buf[80] = {0}; cx->err = PEZ_ERuntime; vsnprintf(buf, sizeof buf, fmt, ap); if (ip >= 0) { // from bytecode execution - Fn *fn = fn_; - assert(fn); - snprintf(cx->errstr, sizeof cx->errstr, "%s:%s:%d: %s", - fn->file ? fn->file : "?", fn->named ? fn->name : "?", - fn->linebegin, + Proto *pr = ((Fn *)fn)->proto; + assert(pr); + snprintf(cx->errstr, sizeof cx->errstr, "%s:%s:%d-%d: %s", + pr->file ? pr->file : "?", pr->named ? pr->name : "?", + pr->linebegin, pr->lineend, buf); } else { // from C code - char *fn = fn_; + const char *name = fn; snprintf(cx->errstr, sizeof cx->errstr, "[C]:%s: %s", - fn ? fn : "?", buf); + name ? name : "?", buf); } cx->errstr[sizeof cx->errstr - 1] = 0; } @@ -794,25 +949,25 @@ inspectstr(const char *s, size_t len) } static void -inspectfn(Fn *fn) +inspectproto(Proto *pr) { int n; - for (int i = 0; i < fn->ncon; ++i) { - Val k = fn->con[i]; - if (isobj_of(k, PEZ_TFn)) { - inspectfn((Fn *)unbox_obj(k)); + for (int i = 0; i < pr->ncon; ++i) { + Val k = pr->con[i]; + if (isobj_of(k, PEZ_TFnProto)) { + inspectproto(unbox_obj(k)); } } - n = fprintf(stderr, "fn %s [%d%s]:\n", fn->name, - fn->nparams, fn->variadic ? ",*" : ""); - for (uint ip = 0; ip < fn->ncode;) { - uint8_t o = fn->code[ip++]; - const uint8_t *argp = &fn->code[ip]; + n = fprintf(stderr, "fn %s[%d%s]:\n", pr->named ? pr->name : "", + pr->nparams, pr->variadic ? ",*" : ""); + for (uint ip = 0; ip < pr->ncode;) { + uint8_t o = pr->code[ip++]; + const uint8_t *argp = &pr->code[ip]; int16_t i16; uint dst; fixnum num; Val v; - Fn *ofn; + Proto *opr; fprintf(stderr, "%.4X:\t%s \t", ip-1, opnames[o]); switch (o) { @@ -843,21 +998,21 @@ inspectfn(Fn *fn) break; case Ostring: ++ip; - assert(*argp < fn->ncon); - v = fn->con[*argp]; + assert(*argp < pr->ncon); + v = pr->con[*argp]; assert(isobj_of(v, PEZ_TString)); inspectstr(((Str *)unbox_obj(v))->dat, ((Str *)unbox_obj(v))->n); break; case Olambda: ++ip; - assert(*argp < fn->ncon); - v = fn->con[*argp]; - assert(isobj_of(v, PEZ_TFn)); - ofn = (Fn *)unbox_obj(v); - if (ofn->named) { - fprintf(stderr, "<fn'%s %p>", ofn->name, ofn); + assert(*argp < pr->ncon); + v = pr->con[*argp]; + assert(isobj_of(v, PEZ_TFnProto)); + opr = unbox_obj(v); + if (opr->named) { + fprintf(stderr, "<'%s %p>", opr->name, opr); } else { - fprintf(stderr, "<fn %p>", ofn); + fprintf(stderr, "<%p>", opr); } break; case Oapply: case Osetapp: case Onewarr: case Oarradd: @@ -868,7 +1023,7 @@ inspectfn(Fn *fn) memcpy(&i16, argp, 2); ip += 2; dst = ip + i16; - assert(dst < fn->ncode); + assert(dst < pr->ncode); fprintf(stderr, "%.4X", dst); break; } @@ -959,10 +1114,10 @@ apply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n) int idx; Val *args = cx->stktop - n, arg; if (isobj_of(recv, PEZ_TFn)) { - Fn *f = (Fn *)unbox_obj(recv); - if (f->variadic ? n < f->nparams : n != f->nparams) { + Fn *f = unbox_obj(recv); + if (f->proto->variadic ? n < f->proto->nparams : n != f->proto->nparams) { runerr(cx, srcfn, srcpc, "function takes %d arg(s), %d %s given", - f->nparams, n, n == 1 ? "was" : "were"); + f->proto->nparams, n, n == 1 ? "was" : "were"); return 0; } TRY(exefn(cx, f, n)); @@ -976,7 +1131,7 @@ apply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n) *ret = *peek(cx); cx->stktop = stktop; } else if (isobj_of(recv, PEZ_TArray)) { - Array *arr = (Array *)unbox_obj(recv); + Array *arr = unbox_obj(recv); if (n != 1) { runerr(cx, srcfn, srcpc, "array indexing takes one argument (got %d)", n); return 0; @@ -1026,7 +1181,7 @@ setapply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n, Val runerr(cx, srcfn, srcpc, "procedure has no setter"); return 0; } else if (isobj_of(recv, PEZ_TArray)) { - Array *arr = (Array *)unbox_obj(recv); + Array *arr = unbox_obj(recv); if (n != 1) { runerr(cx, srcfn, srcpc, "array indexing takes one argument"); return 0; @@ -1051,11 +1206,12 @@ setapply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n, Val static bool exefn(PezContext *cx, Fn *fn, uint nargs) { - const uint8_t *code = fn->code; + Proto *pr = fn->proto; + const uint8_t *code = pr->code; Val *args = cx->stktop - nargs, *locals = cx->stktop; uint ip = 0; - for (int i = 0; i < fn->nvars; ++i) { + for (int i = 0; i < pr->nvars; ++i) { TRY(push(cx, VOID)); } #ifdef __GNUC__ @@ -1078,7 +1234,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) CASE(Onop) {} CASE(Oret) { Val ret = pop(cx); - cx->stktop -= fn->nvars; + cx->stktop -= pr->nvars; assert(cx->stktop >= cx->stack); push(cx, ret); return 1; @@ -1151,18 +1307,20 @@ exefn(PezContext *cx, Fn *fn, uint nargs) CASE(Ostring) { uint8_t idx = code[ip++]; Val v; - assert(idx < fn->ncon); - v = fn->con[idx]; + assert(idx < pr->ncon); + v = pr->con[idx]; assert(isobj_of(v, PEZ_TString)); TRY(push(cx, v)); } CASE(Olambda) { uint8_t idx = code[ip++]; - Val v; - assert(idx < fn->ncon); - v = fn->con[idx]; - assert(isobj_of(v, PEZ_TFn)); - TRY(push(cx, v)); + Val k; + Fn *fn; + assert(idx < pr->ncon); + k = pr->con[idx]; + assert(isobj_of(k, PEZ_TFnProto)); + TRY(fn = newfn(cx, unbox_obj(k))); + TRY(push(cx, box_obj(fn))); } CASE(Onot) { Val *p = peek(cx); @@ -1271,7 +1429,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) unbox_sstr(k, buf); name = buf; } else if (isobj_of(k, PEZ_TString)) { - Str *s = (Str *)unbox_obj(k); + Str *s = unbox_obj(k); name = s->dat; } else { assert(0); } runerr(cx, fn, ip, "no such global \"%s\"", name); @@ -1291,7 +1449,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) unbox_sstr(k, buf); name = buf; } else if (isobj_of(k, PEZ_TString)) { - Str *s = (Str *)unbox_obj(k); + Str *s = unbox_obj(k); name = s->dat; } else { assert(0); } runerr(cx, fn, ip, "no such global \"%s\"", name); @@ -1312,10 +1470,11 @@ exefn(PezContext *cx, Fn *fn, uint nargs) memmove(cx->stktop - n - 1, cx->stktop - n, n * sizeof(Val)); --cx->stktop; if (isobj_of(lhs, PEZ_TFn)) { - Fn *f = (Fn *)unbox_obj(lhs); - if (f->variadic ? n < f->nparams : n != f->nparams) { + Fn *f = unbox_obj(lhs); + Proto *pr = f->proto; + if (pr->variadic ? n < pr->nparams : n != pr->nparams) { runerr(cx, fn, ip, "function takes %d arg(s), %d %s given", - f->nparams, n, n == 1 ? "was" : "were"); + pr->nparams, n, n == 1 ? "was" : "were"); return 0; } TRY(exefn(cx, f, n)); @@ -1355,15 +1514,17 @@ exefn(PezContext *cx, Fn *fn, uint nargs) uint8_t n = code[ip++]; Array *arr = newarr(cx, n); TRY(arr != NULL); - TRY(arrpushn(cx, arr, cx->stktop - n, n)); + TRY(push(cx, box_obj(arr))); // gc keep + TRY(arrpushn(cx, arr, cx->stktop - n - 1, n)); + pop(cx); cx->stktop -= n; - TRY(push(cx, box_obj(arr))); + push(cx, box_obj(arr)); } CASE(Oarradd) { uint8_t n = code[ip++]; Val r = cx->stktop[-n - 1]; - Array *arr = (Array *)unbox_obj(r); - assert(isobj(r) && arr->o.t == PEZ_TArray); + Array *arr = unbox_obj(r); + assert(isobj(r) && arr->t == PEZ_TArray); TRY(arrpushn(cx, arr, cx->stktop - n, n)); cx->stktop -= n; } @@ -1372,7 +1533,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) uint dst; memcpy(&off, &code[ip], 2), ip += 2; dst = ip + off; - assert(dst < fn->ncode); + assert(dst < pr->ncode); ip = dst; } CASE(Obt) { @@ -1381,7 +1542,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) Val v = pop(cx); memcpy(&off, &code[ip], 2), ip += 2; dst = ip + off; - assert(dst < fn->ncode); + assert(dst < pr->ncode); if (truthy(v)) { ip = dst; } @@ -1392,7 +1553,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) Val v = pop(cx); memcpy(&off, &code[ip], 2), ip += 2; dst = ip + off; - assert(dst < fn->ncode); + assert(dst < pr->ncode); if (!truthy(v)) { ip = dst; } @@ -1469,7 +1630,9 @@ xprint1(PezContext *cx, struct vals *seen, TRY(ok); } else if (iscfn(v) || isobj_of(v, PEZ_TFn)) { const char *name = - isobj_of(v, PEZ_TFn) && ((Fn *)unbox_obj(v))->named ? ((Fn *)unbox_obj(v))->name : NULL; + isobj_of(v, PEZ_TFn) && ((Fn *)unbox_obj(v))->proto->named + ? ((Fn *)unbox_obj(v))->proto->name + : NULL; if (name) { TRY(cb(cx, u, "#<function ", 11)); TRY(cb(cx, u, name, strlen(name))); @@ -1478,7 +1641,7 @@ xprint1(PezContext *cx, struct vals *seen, TRY(cb(cx, u, "#<function>", 11)); } } else if (isobj_of(v, PEZ_TArray)) { - Array *arr = (Array *)unbox_obj(v); + Array *arr = unbox_obj(v); bool ok = 1; TRY(vecpush(cx, seen, &v, 1)); ok &= cb(cx, u, "#[", 2); @@ -1615,7 +1778,7 @@ initcore(PezContext *cx) /*******************/ static void -initcomp(Comp *cm, PezContext *cx, Fn *fn, int (*cb)(void *), void *ud) +initcomp(Comp *cm, PezContext *cx, Proto *pr, int (*cb)(void *), void *ud) { memset(cm, 0, sizeof *cm); cm->cx = cx; @@ -1624,7 +1787,7 @@ initcomp(Comp *cm, PezContext *cx, Fn *fn, int (*cb)(void *), void *ud) cm->line = 1; cm->col = 0; cm->lastop = cm->lastop2 = -1; - cm->fn = fn; + cm->proto = pr; } static void @@ -1644,15 +1807,16 @@ deinitcomp(Comp *cm) static void fincompfn(Comp *cm) { - Fn *f = cm->fn; - const uint8_t *code = cm->cx->alloc(cm->cx->ud, cm->code.at, cm->code.cap, cm->code.len); - const Val *con = cm->cx->alloc(cm->cx->ud, cm->con.at, + Proto *pr = cm->proto; + const uint8_t *code = cxrealloc(cm->cx, cm->code.at, cm->code.cap, cm->code.len); + const Val *con = cxrealloc(cm->cx, cm->con.at, cm->con.cap * sizeof(Val), cm->con.len * sizeof(Val)); assert(code != NULL && (cm->con.len == 0 || con != NULL) && "can't shrink?"); - f->code = code; - f->ncode = cm->code.len; - f->con = con; - f->ncon = cm->con.len; + pr->lineend = cm->line; + pr->code = code; + pr->ncode = cm->code.len; + pr->con = con; + pr->ncon = cm->con.len; } static void @@ -1667,7 +1831,7 @@ comperr(Comp *cm, int ch, const char *fmt, ...) va_end(ap); sprintf(buf2, "'%c'", ch); snprintf(cm->cx->errstr, sizeof cm->cx->errstr, - "%s:%d:%d: %s (near %s)", cm->fn->file, + "%s:%d:%d: %s (near %s)", cm->proto->file, cm->line, cm->col, buf, ch == EOF ? "<EOF>" : buf2); cm->cx->errstr[sizeof cm->cx->errstr - 1] = 0; } @@ -1727,7 +1891,7 @@ compconst(Comp *cm, Val v) TRY(compbytes(cm, s, n)); return 1; } - if (isobj(v) && ((t = objtag(v)) == PEZ_TString || t == PEZ_TFn)) { + if (isobj(v) && (t = objtag(v)) == PEZ_TString) { uint8_t idx = cm->con.len; for (int i = 0; i < cm->con.len; ++i) { if (cm->con.at[i].r == v.r) { @@ -1741,7 +1905,7 @@ compconst(Comp *cm, Val v) } K: vecpush(cm->cx, &cm->con, &v, 1); - TRY(compop(cm, t == PEZ_TString ? Ostring : Olambda)); + TRY(compop(cm, Ostring)); TRY(compbyte(cm, idx)); return 1; } @@ -1780,7 +1944,7 @@ addparam(Comp *cm, const char *name) assert(l.scope == 0); assert(l.sref == cm->spool.len); TRY(vecpush(cm->cx, &cm->spool, name, strlen(name) + 1)); - l.index = cm->fn->nparams++; + l.index = cm->proto->nparams++; TRY(vecpush(cm->cx, &fenv->locals, &l, 1)); return 1; } @@ -1810,7 +1974,7 @@ addlocal(Comp *cm, uint *idx, const char *name, bool mutable, bool has_k, Val k) if (!has_k) { // this renders into a stack slot *idx = l.index = fenv->nvars++; - cm->fn->nvars = MAX(cm->fn->nvars, fenv->nvars); + cm->proto->nvars = MAX(cm->proto->nvars, fenv->nvars); } else { // to propagate constant folding through const locals TRY(vecpush(cm->cx, &cm->kpool, &k, 1)); @@ -2001,10 +2165,24 @@ static bool block(Comp *cm, int endchr); static bool expr(Comp *cm); static bool -lambda(Comp *cm, const char *name) +compclosure(Comp *cm, Proto *pr) { - Fn *fn = newfn(cm->cx, cm->fn->file, name, cm->line); - Fn *prevfn = cm->fn; + Val k = box_obj(pr); + if (cm->con.len == UINT8_MAX) { + comperr(cm, peekchr(cm), "too many consts"); + return 0; + } + TRY(vecpush(cm->cx, &cm->con, &k, 1)); + TRY(compop(cm, Olambda)); + TRY(compbyte(cm, cm->con.len - 1)); + return 1; +} + +static bool +lambdaexpr(Comp *cm, const char *name) +{ + Proto *proto = newproto(cm->cx, cm->proto->file, name, cm->line); + Proto *prevfn = cm->proto; vec_of(uint8_t) prevcode; vec_of(Val) prevcon; struct fenv prevfenv = cm->fenv;; @@ -2015,8 +2193,9 @@ lambda(Comp *cm, const char *name) memset(&cm->code, 0, sizeof cm->code); memcpy(&prevcon, &cm->con, sizeof prevcon); memset(&cm->con, 0, sizeof cm->con); - cm->fn = fn; + cm->proto = proto; cm->fenv = fenv; + ETRY(push(cm->cx, box_obj(proto))); // gc keep if (matchspchr(cm, '[')) { while (!matchspchr(cm, ']')) { @@ -2038,17 +2217,18 @@ lambda(Comp *cm, const char *name) } } + pop(cm->cx); // proto gc ETRY(block(cm, '}')); ETRY(compop(cm, Oret)); fincompfn(cm); Cleanup: - cm->fn = prevfn; + cm->proto = prevfn; memcpy(&cm->code, &prevcode, sizeof prevcode); memcpy(&cm->con, &prevcon, sizeof prevcon); delfenv(cm->cx, &cm->fenv); cm->fenv = prevfenv; - return ret && compconst(cm, box_obj(fn)); + return ret && compclosure(cm, proto); Err: ret = 1; @@ -2230,7 +2410,7 @@ primaryexpr(Comp *cm) return 1; case '{': - return lambda(cm, NULL); + return lambdaexpr(cm, NULL); case '#': // other literals @@ -2946,7 +3126,7 @@ decl(Comp *cm, Local **pl, bool nofold) if (matchspchr(cm, '{')) { // named fn, possibly recursive TRY(l = addlocal(cm, &idx, name, mutable, cm->has_k && !mutable, cm->k)); - TRY(lambda(cm, name)); + TRY(lambdaexpr(cm, name)); } else { TRY(expr(cm)); // initializer if (cm->has_k && nofold) { @@ -3169,21 +3349,32 @@ bool pez_eval_cb(PezContext *cx, const char *fname, int (*cb)(void *), void *ud) { Val *stktop = cx->stktop; - Fn *fn = newfn(cx, fname, "<eval>", /* line */ 1); + Proto *pr; + Fn *fn; Comp cm; - if (!fn) { + cx->gccanrun = 0; + if (!(pr = newproto(cx, fname, "<eval>", /* line */ 1))) { return 0; } - initcomp(&cm, cx, fn, cb, ud); + if (!(fn = newfn(cx, pr))) { + delproto(cx, pr); + return 0; + } + initcomp(&cm, cx, pr, cb, ud); ETRY(block(&cm, EOF)); ETRY(compop(&cm, Oret)); fincompfn(&cm); if (cx->dbg & DBGbytecode) { - inspectfn(fn); + inspectproto(pr); } + cx->gccanrun = 1; + ETRY(push(cx, box_obj(fn))); // gc keep ETRY(exefn(cx, fn, 0)); + cx->stktop[-2] = cx->stktop[-1]; + --cx->stktop; // gc unkeep + cx->gccanrun = 0; deinitcomp(&cm); return 1; @@ -3449,7 +3640,7 @@ pez_getstring(PezContext *cx, char buf[8], int idx) return buf; } if (isobj_of(v, PEZ_TString)) { - Str *s = (Str *)unbox_obj(v); + Str *s = unbox_obj(v); return s->dat; } return NULL; @@ -3460,9 +3651,9 @@ pez_fnname(PezContext *cx, int idx) { Val v = *iget(cx, idx); if (isobj_of(v, PEZ_TFn)) { - Fn *fn = ((Fn *)unbox_obj(v)); - if (fn->named) { - return fn->name; + Fn *fn = unbox_obj(v); + if (fn->proto->named) { + return fn->proto->name; } } return NULL; @@ -14,6 +14,7 @@ enum { PEZ_TNumber, PEZ_TBool, PEZ_TString, + PEZ_TFnProto, PEZ_TFn, PEZ_TTuple, PEZ_TRecord, @@ -96,10 +97,11 @@ pez_fixmul(PezNumber a, PezNumber b) static inline PezNumber pez_fixdiv(PezNumber a, PezNumber b) { + int64_t tmp; if (b == 0) { return a >= 0 ? INT32_MAX : INT32_MIN; } - int64_t tmp = (uint64_t)a << 12; + tmp = (uint64_t)a << 12; /* if ((tmp < 0) == (b < 0)) { tmp += b >> 1; @@ -13,7 +13,8 @@ } while (0) static bool -printtop(PezContext *cx) { +printtop(PezContext *cx) +{ assert(pez_top(cx) >= 2); return pez_push(cx, 0) // printf was stored here @@ -1,4 +1,4 @@ -~fib = {[x] +~fib= {[x] x < 2 ? x : fib[x - 1] + fib[x - 2] } |