From 3bad89b205b211f42e24ec1facf16b6a2ecb1627 Mon Sep 17 00:00:00 2001 From: lemon Date: Thu, 13 Oct 2022 15:07:19 +0200 Subject: [PATCH] stack effects + optimize exefn --- pez.c | 251 +++++++++++++++++++++++++++++++++++---------------------- repl.c | 2 +- 2 files changed, 154 insertions(+), 99 deletions(-) diff --git a/pez.c b/pez.c index 591b760..db36848 100644 --- a/pez.c +++ b/pez.c @@ -72,6 +72,7 @@ typedef struct Proto { named : 1; short nvars, nparams; short ncon, nupval; + int nstack; uint ncode; int linebegin, lineend; const char *file; @@ -142,8 +143,10 @@ typedef struct Comp { int stash_binopop; Proto *proto; - vec_of(uint8_t, 16) code; - vec_of(Val, 2) con; + vec_of(uint8_t, 32) code; + vec_of(Val, 8) con; + + int stk; /* relative stack top after last instr */ Val k; /* for constant folding */ bool has_k; @@ -1188,8 +1191,8 @@ inspectproto(Proto *pr) inspectproto(unbox_obj(k)); } } - n = fprintf(stderr, "fn %s[%d%s]:\n", pr->named ? pr->name : "", - pr->nparams, pr->variadic ? ",*" : ""); + n = fprintf(stderr, "fn %s[%d%s; %dstk]:\n", pr->named ? pr->name : "", + pr->nparams, pr->variadic ? ",*" : "", pr->nstack); for (uint ip = 0; ip < pr->ncode;) { uint8_t o = pr->code[ip++]; const uint8_t *argp = &pr->code[ip]; @@ -1208,7 +1211,7 @@ inspectproto(Proto *pr) case Obyte: case Oiadd: case Oimul: case Oidiv: case Oimod: case Oiband: case Oibior: case Oibxor: case Oishl: case Oishrl: case Oishra: case Oilt: - case Oile: case Oigt: case Oige: case Oeq: case One: + case Oile: case Oigt: case Oige: case Oieq: case Oine: ++ip; fprintf(stderr, "%d", (int8_t)*argp); break; @@ -1453,11 +1456,18 @@ exefn(PezContext *cx, Fn *fn, uint nargs) Proto *pr = fn->proto; const uint8_t *code = pr->code; Val *args = cx->stktop - nargs, - *locals = cx->stktop; + *locals = cx->stktop, + *stktop = cx->stktop; uint ip = 0; for (int i = 0; i < pr->nvars; ++i) { TRY(push(cx, VOID)); + ++stktop; + } + assert(pr->nstack > 0); + if (stktop + pr->nstack >= cx->stkend) { + return cx->err = PEZ_EStack, 0; } + #ifdef __GNUC__ // use computed goto #define X(o,_) &&DoO##o, @@ -1473,67 +1483,72 @@ exefn(PezContext *cx, Fn *fn, uint nargs) #define CASE(o) break; case o: #define BADOP break; default: #endif +#define push(x) (*stktop++ = (x)) +#define pop() (*--stktop) +#define peek() (&stktop[-1]) VMBEGIN CASE(Onop) {} CASE(Oret) { - Val ret = pop(cx); - cx->stktop = locals; - assert(cx->stktop >= cx->stack); - push(cx, ret); + Val ret = pop(); + stktop = locals; + assert(stktop >= cx->stack); + push(ret); closeups(cx, args); + cx->stktop = stktop; return 1; } CASE(Opop) { - pop(cx); + (void)pop(); } CASE(Odup) { - TRY(push(cx, *peek(cx))); + Val x = *peek(); + push(x); } CASE(Odupn) { int n = code[ip++] + 1; - Val *it = cx->stktop - n; - assert(cx->stktop > cx->stack + n); + Val *it = stktop - n; + assert(stktop > cx->stack + n); for (int i = 0; i < n; ++i) { - TRY(push(cx, it[i])); + push(it[i]); } } CASE(Odupbck) { Val v; - assert(cx->stktop > cx->stack + 1); - v = *peek(cx); - TRY(push(cx, VOID)); - cx->stktop[-1] = cx->stktop[-2]; - cx->stktop[-2] = cx->stktop[-3]; - cx->stktop[-3] = v; + assert(stktop > cx->stack + 1); + v = *peek(); + push(VOID); + stktop[-1] = stktop[-2]; + stktop[-2] = stktop[-3]; + stktop[-3] = v; } CASE(Ovoid) { - TRY(push(cx, VOID)); + push(VOID); } CASE(Ozero) { - TRY(push(cx, box_num(FX(0)))); + push(box_num(FX(0))); } CASE(Oone) { - TRY(push(cx, box_num(FX(1)))); + push(box_num(FX(1))); } CASE(Obyte) { - TRY(push(cx, box_num(inttofix((int8_t)code[ip++])))); + push(box_num(inttofix((int8_t)code[ip++]))); } CASE(Oshort) { int16_t i16; memcpy(&i16, &code[ip], 2), ip += 2; - TRY(push(cx, box_num(inttofix(i16)))); + push(box_num(inttofix(i16))); } CASE(Onumber) { fixnum num; memcpy(&num, &code[ip], 4), ip += 4; - TRY(push(cx, box_num(num))); + push(box_num(num)); } CASE(Ofalse) { - TRY(push(cx, box_bool(0))); + push(box_bool(0)); } CASE(Otrue) { - TRY(push(cx, box_bool(1))); + push(box_bool(1)); } #define SSTR(n) \ CASE(Osstr##n) { \ @@ -1544,7 +1559,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) ip += n; \ ok = box_str(cx, &v, buf, n); \ assert(ok); \ - TRY(push(cx, v)); \ + push(v); \ } SSTR(0) SSTR(1) SSTR(2) SSTR(3) SSTR(4) SSTR(5) SSTR(6) SSTR(7) @@ -1555,7 +1570,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) assert(idx < pr->ncon); v = pr->con[idx]; assert(isobj_of(v, PEZ_TString)); - TRY(push(cx, v)); + push(v); } CASE(Olambda) { uint8_t idx = code[ip++]; @@ -1564,15 +1579,17 @@ exefn(PezContext *cx, Fn *fn, uint nargs) assert(idx < pr->ncon); k = pr->con[idx]; assert(isobj_of(k, PEZ_TFnProto)); + cx->stktop = stktop; TRY(ofn = newfn(cx, unbox_obj(k), args, locals, fn)); - TRY(push(cx, box_obj(ofn))); + stktop = cx->stktop; + push(box_obj(ofn)); } CASE(Onot) { - Val *p = peek(cx); + Val *p = peek(); *p = box_bool(!truthy(*p)); } CASE(Oneg) { - Val *p = peek(cx); + Val *p = peek(); if (!isnum(*p)) { return runerr(cx, fn, ip, "attempt to negate %s value", typestr(*p)), 0; } @@ -1580,13 +1597,13 @@ exefn(PezContext *cx, Fn *fn, uint nargs) } #define ARITH(o, oname) \ CASE(O##o) { \ - Val b = pop(cx), a = pop(cx); \ + Val b = pop(), a = pop(); \ if (!isnum(a) || !isnum(b)) { \ runerr(cx, fn, ip, "cannot %s %s and %s values", \ oname, typestr(a), typestr(b)); \ return 0; \ } \ - push(cx, UDO_O##o(a, b)); \ + push(UDO_O##o(a, b)); \ } ARITH(add, "add") ARITH(sub, "subtract") @@ -1606,7 +1623,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) #undef ARITH #define IARITH(o, oname, expr) \ CASE(O##i##o) { \ - Val *p = peek(cx), a = *p; \ + Val *p = peek(), a = *p; \ int32_t iimm =(int8_t)code[ip++]; \ fixnum nimm = (uint32_t)iimm << 12; (void)nimm; \ fixnum x = unbox_num(a); \ @@ -1633,80 +1650,80 @@ exefn(PezContext *cx, Fn *fn, uint nargs) IARITH(ge, "compare", box_bool(x >= nimm)) #undef IARITH CASE(Oeq) { - Val a = pop(cx), b = pop(cx); - push(cx, box_bool(a.r == b.r)); + Val a = pop(), b = pop(); + push(box_bool(a.r == b.r)); } CASE(One) { - Val a = pop(cx), b = pop(cx); - push(cx, box_bool(a.r != b.r)); + Val a = pop(), b = pop(); + push(box_bool(a.r != b.r)); } CASE(Oieq) { - *peek(cx) = box_bool(peek(cx)->r == box_num((int8_t)code[ip++] << 12).r); + *peek() = box_bool(peek()->r == box_num((int8_t)code[ip++] << 12).r); } CASE(Oine) { - *peek(cx) = box_bool(peek(cx)->r != box_num((int8_t)code[ip++] << 12).r); + *peek() = box_bool(peek()->r != box_num((int8_t)code[ip++] << 12).r); } CASE(Oarg) { uint8_t idx = code[ip++]; - TRY(push(cx, args[idx])); + push(args[idx]); } CASE(Osetarg) { uint8_t idx = code[ip++]; - args[idx] = pop(cx); + args[idx] = pop(); } CASE(Olocal) { uint8_t idx = code[ip++]; - TRY(push(cx, locals[idx])); + push(locals[idx]); } CASE(Osetloc) { uint8_t idx = code[ip++]; - locals[idx] = pop(cx); + locals[idx] = pop(); } CASE(Oupval) { uint8_t idx = code[ip++]; assert(idx < fn->nupval); - TRY(push(cx, *fn->upval[idx]->ptr)); + push(*fn->upval[idx]->ptr); } CASE(Osetupv) { uint8_t idx = code[ip++]; assert(idx < fn->nupval); - *fn->upval[idx]->ptr = pop(cx); + *fn->upval[idx]->ptr = pop(); } CASE(Oclose) { uint8_t idx = code[ip++]; closeups(cx, &locals[idx]); } CASE(Oargc) { - TRY(push(cx, box_num(inttofix(nargs - pr->nparams)))); + push(box_num(inttofix(nargs - pr->nparams))); } CASE(Ovararg) { - Val a = pop(cx); + Val a = pop(); fixnum num = unbox_num(a); int idx = fixtoint(num) + pr->nparams; if (!isnum(a) || num < 0 || fixtrunc(num) != num) { return runerr(cx, fn, ip, "SEL expected positive integer index"), 0; } - TRY(push(cx, idx >= nargs ? VOID : args[idx])); + push(idx >= nargs ? VOID : args[idx]); } CASE(Ogather) { int n = nargs - pr->nparams; Array *arr = newarr(cx, n); TRY(arr); - TRY(push(cx, box_obj(arr))); + push(box_obj(arr)); TRY(arrpushn(cx, arr, args + pr->nparams, n)); } CASE(Oglobal) { - Val k = pop(cx), *v; - if ((v = getglobal(cx, k))) { - push(cx, *v); + Val *k = peek(), *v; + if ((v = getglobal(cx, *k))) { + *k = *v; } else { char buf[8]; const char *name; - if (issstr(k)) { - unbox_sstr(k, buf); + if (issstr(*k)) { + unbox_sstr(*k, buf); name = buf; - } else if (isobj_of(k, PEZ_TString)) { - Str *s = unbox_obj(k); + } else if (isobj_of(*k, PEZ_TString)) { + Str *s = unbox_obj(*k); name = s->dat; } else { assert(0); } return runerr(cx, fn, ip, "no such global \"%s\"", name), 0; @@ -1714,8 +1731,8 @@ exefn(PezContext *cx, Fn *fn, uint nargs) } CASE(Osetglo) { Val k, v, *g; - v = pop(cx); - k = pop(cx); + v = pop(); + k = pop(); if ((g = getglobal(cx, k))) { *g = v; } else { @@ -1733,17 +1750,16 @@ exefn(PezContext *cx, Fn *fn, uint nargs) } CASE(Oputglo) { Val k, v; - v = pop(cx); - k = pop(cx); + v = pop(); + k = pop(); TRY(putglobal(cx, k, v)); } CASE(Oapply) { uint8_t n = code[ip++]; Val lhs, ret; - assert(cx->stktop - n - 1 >= cx->stack); - lhs = cx->stktop[-n - 1]; - memmove(cx->stktop - n - 1, cx->stktop - n, n * sizeof(Val)); - --cx->stktop; + lhs = stktop[-n - 1]; + memmove(stktop - n - 1, stktop - n, n * sizeof(Val)); + --stktop; if (isobj_of(lhs, PEZ_TFn)) { Fn *f = unbox_obj(lhs); Proto *pr = f->proto; @@ -1752,56 +1768,65 @@ exefn(PezContext *cx, Fn *fn, uint nargs) pr->nparams, n, n == 1 ? "was" : "were"); return 0; } + cx->stktop = stktop; TRY(exefn(cx, f, n)); - ret = pop(cx); - cx->stktop -= n-1; - *peek(cx) = ret; + stktop = cx->stktop; + ret = pop(); + stktop -= n-1; + *peek() = ret; } else { + cx->stktop = stktop; TRY(apply(cx, &ret, fn, ip, lhs, n)); - cx->stktop -= n-1; - *peek(cx) = ret; + stktop = cx->stktop; + stktop -= n-1; + *peek() = ret; } } CASE(Osetapp) { uint8_t n = code[ip++]; - Val rval = pop(cx), - a = cx->stktop[-1 - n], + Val rval = pop(), + a = stktop[-1 - n], ret; + cx->stktop = stktop; TRY(setapply(cx, &ret, fn, ip, a, n, rval)); - cx->stktop -= n; - cx->stktop[-1] = ret; + stktop = cx->stktop; + stktop -= n; + stktop[-1] = ret; } CASE(Olength) { - Val a = *peek(cx); + Val a = *peek(); if (isobj_of(a, PEZ_TArray)) { - *peek(cx) = box_num(inttofix(((Array *)unbox_obj(a))->len)); + *peek() = box_num(inttofix(((Array *)unbox_obj(a))->len)); } else { Val arg, ret; bool ok = box_str(cx, &arg, "length", 6); assert(ok); - TRY(push(cx, arg)); + push(arg); + cx->stktop = stktop; TRY(apply(cx, &ret, fn, ip, a, 1)); - --cx->stktop; - *peek(cx) = ret; + stktop = cx->stktop; + --stktop; + *peek() = ret; } } CASE(Onewarr) { uint8_t n = code[ip++]; - Array *arr = newarr(cx, n); - TRY(arr != NULL); - TRY(push(cx, box_obj(arr))); // gc keep + Array *arr; + cx->stktop = stktop; + TRY((arr = newarr(cx, n)) != NULL); + TRY((push)(cx, box_obj(arr))); // gc keep + stktop = cx->stktop; TRY(arrpushn(cx, arr, cx->stktop - n - 1, n)); - pop(cx); - cx->stktop -= n; - push(cx, box_obj(arr)); + stktop -= n + 1; + push(box_obj(arr)); } CASE(Oarradd) { uint8_t n = code[ip++]; - Val r = cx->stktop[-n - 1]; + Val r = stktop[-n - 1]; Array *arr = unbox_obj(r); assert(isobj(r) && arr->t == PEZ_TArray); - TRY(arrpushn(cx, arr, cx->stktop - n, n)); - cx->stktop -= n; + TRY(arrpushn(cx, arr, stktop - n, n)); + stktop -= n; } CASE(Ob) { int16_t off; @@ -1814,7 +1839,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) CASE(Obt) { int16_t off; uint dst; - Val v = pop(cx); + Val v = pop(); memcpy(&off, &code[ip], 2), ip += 2; dst = ip + off; assert(dst < pr->ncode); @@ -1825,7 +1850,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs) CASE(Obf) { int16_t off; uint dst; - Val v = pop(cx); + Val v = pop(); memcpy(&off, &code[ip], 2), ip += 2; dst = ip + off; assert(dst < pr->ncode); @@ -1837,6 +1862,9 @@ exefn(PezContext *cx, Fn *fn, uint nargs) return runerr(cx, fn, ip, "bad opcode %#x", code[ip-1]), 0; } VMEND +#undef peek +#undef push +#undef pop #undef BADOP #undef CASE #undef VMEND @@ -2192,7 +2220,7 @@ compconst(Comp *cm, Val v) } else if (num == fixtrunc(num) && num >= FX(-128) && num < FX(127)) { int8_t n = fixtoint(num); TRY(compop(cm, Obyte)); - TRY(compop(cm, n)); + TRY(compbyte(cm, n)); } else if (num == fixtrunc(num) && num >= FX(-32768) && num < FX(32768)) { int16_t n = fixtoint(num); TRY(compop(cm, Oshort)); @@ -2236,8 +2264,15 @@ compconst(Comp *cm, Val v) return 0; } +static void +compeffect(Comp *cm, int n) +{ + cm->stk += n; + cm->proto->nstack = MAX(cm->proto->nstack, cm->stk); +} + static bool -compop(Comp *cm, enum op x) +compop(Comp *cm, enum op op) { if (cm->has_k) { cm->has_k = 0; @@ -2245,7 +2280,8 @@ compop(Comp *cm, enum op x) } cm->lastop2 = cm->lastop; cm->lastop = cm->code.len; - return compbyte(cm, x); + compeffect(cm, opeffects[op]); + return compbyte(cm, op); } /* must be called after emitting any branches to avoid @@ -2569,6 +2605,7 @@ lambdaexpr(Comp *cm, const char *name) { Proto *proto = newproto(cm->cx, cm->proto->file, name, cm->line); Proto *prevfn = cm->proto; + int prevstk = cm->stk; vec_of(uint8_t, sizeof cm->code.inl) prevcode; vec_of(Val, sizeof cm->con.inl / sizeof(Val)) prevcon; struct fenv *prevfenv = cm->fenv; @@ -2581,6 +2618,7 @@ lambdaexpr(Comp *cm, const char *name) memset(&cm->con, 0, sizeof cm->con); cm->proto = proto; cm->fenv = &fenv; + cm->stk = 0; if (matchspchr(cm, '[')) { while (!matchspchr(cm, ']')) { @@ -2622,6 +2660,7 @@ Cleanup: memcpy(&cm->con, &prevcon, sizeof prevcon); delfenv(cm->cx, &fenv); cm->fenv = prevfenv; + cm->stk = prevstk; return ret && compclosure(cm, proto); Err: @@ -2877,6 +2916,7 @@ primaryexpr(Comp *cm) if (++n == 255) { TRY(compop(cm, big ? Oarradd : Onewarr)); TRY(compbyte(cm, n)); + compeffect(cm, big ? -n : -n + 1); big = 1; n = 0; } @@ -2886,6 +2926,7 @@ primaryexpr(Comp *cm) } } TRY(compop(cm, big ? Oarradd : Onewarr)); + compeffect(cm, big ? -n : -n + 1); TRY(compbyte(cm, n)); return 1; } else if (c == EOF || aisspace(c)) { @@ -2914,12 +2955,15 @@ postfixexpr(Comp *cm) break; } } - assert(n < 256); + if (n >= 256) { + return comperr(cm, peekchr(cm), "too many args for call"), 0; + } cm->lvalue = 1; cm->lvalue_const = 0; cm->lvalue_name = NULL; TRY(compop(cm, Oapply)); TRY(compbyte(cm, n)); + compeffect(cm, -n); } else if (matchspchr(cm, '.')) { int c; char name[NAMEMAX]; @@ -2937,6 +2981,7 @@ postfixexpr(Comp *cm) TRY(compconst(cm, s)); TRY(compop(cm, Oapply)); TRY(compbyte(cm, 1)); + compeffect(cm, -1); } cm->lvalue = 1; cm->lvalue_const = 0; @@ -3326,18 +3371,20 @@ condexpr(Comp *cm) save = *ip; TRY(condexpr(cm)); + --cm->stk; *ip = save; cm->has_k = has_k; cm->k = k; } else if (cm->has_k && !truthy(cm->k)) { save = *ip; TRY(condexpr(cm)); + --cm->stk; *ip = save; cm->has_k = 0; TRY(expectspchr(cm, ':')); TRY(condexpr(cm)); } else { - int bf_arg, bf_jumpfrom, b_arg, b_jumpfrom, diff; + int bf_arg, bf_jumpfrom, b_arg, b_jumpfrom, diff, stk; int16_t off; /* @@ -3352,6 +3399,7 @@ condexpr(Comp *cm) bf_arg = *ip; TRY(compbytes(cm, "X", 2)); bf_jumpfrom = *ip; + stk = cm->stk; TRY(condexpr(cm) && flushconst(cm)); @@ -3368,6 +3416,7 @@ condexpr(Comp *cm) } memcpy(&cm->code.at[bf_arg], &off, 2); + cm->stk = stk; TRY(condexpr(cm) && flushconst(cm)); off = diff = *ip - b_jumpfrom; @@ -3440,6 +3489,7 @@ setexpr(Comp *cm) break; case Oapply: argc = code->at[cm->lastop + 1]; + cm->stk += argc; code->len -= 2; Oapply: if (binop != Oset) { @@ -3447,6 +3497,7 @@ setexpr(Comp *cm) TRY(compbyte(cm, argc)); TRY(compop(cm, Oapply)); TRY(compbyte(cm, argc)); + compeffect(cm, 1); } break; case Olength: @@ -3487,6 +3538,7 @@ setexpr(Comp *cm) case Oapply: TRY(compop(cm, Osetapp)); TRY(compbyte(cm, argc)); + compeffect(cm, -argc - 1); break; } } else if (binop) { @@ -3518,6 +3570,7 @@ discard(Comp *cm) uint8_t *code = cm->code.at; if (cm->lastop != -1 && cm->code.at[cm->lastop] == Ovoid) { --cm->code.len; + --cm->stk; resetlastops(cm); return 1; } else if (cm->lastop != -1 && cm->lastop2 != -1 @@ -3527,11 +3580,13 @@ discard(Comp *cm) case Osetloc: case Osetarg: case Osetupv: memmove(code + cm->lastop2, code + cm->lastop, 2); --cm->code.len; + --cm->stk; resetlastops(cm); return 1; case Osetglo: case Oputglo: memmove(code + cm->lastop2, code + cm->lastop, 1); --cm->code.len; + --cm->stk; resetlastops(cm); return 1; } diff --git a/repl.c b/repl.c index 9aa7bab..dcdb381 100644 --- a/repl.c +++ b/repl.c @@ -51,7 +51,7 @@ main(int argc, char **argv) { if (!strcmp(arg, "-h") || !strcmp(arg, "--help")) { help(); goto Bye; - } else if (arg[1] == 'd') { + } else if (arg[1] == 'd' && arg[2]) { pez_debug(cx, arg + 2); } else { printf("pez: Invalid option '%s'\n", arg); -- 2.38.5