~lsof/pez

3bad89b205b211f42e24ec1facf16b6a2ecb1627 — lemon 1 year, 8 months ago 1111a90 master
stack effects + optimize exefn
2 files changed, 154 insertions(+), 99 deletions(-)

M pez.c
M repl.c
M pez.c => pez.c +153 -98
@@ 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;
        }

M repl.c => repl.c +1 -1
@@ 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);