@@ 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;
/* <cond>
@@ 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;
}