diff options
Diffstat (limited to 'src/interp.c')
| -rw-r--r-- | src/interp.c | 92 |
1 files changed, 82 insertions, 10 deletions
diff --git a/src/interp.c b/src/interp.c index a28df21..8aa4329 100644 --- a/src/interp.c +++ b/src/interp.c @@ -25,6 +25,7 @@ void Interp_init(Interp *self) { String2IntHashTable_init(&self->symbols); int i = 0; SExp sexp; + sexp.marked = false; sexp.type = kNilSExp; SExpVector_push_back(&self->objs, sexp); self->nil = (SExpRef){i}; i++; @@ -92,6 +93,7 @@ void Interp_init(Interp *self) { Interp_add_userfunc(self, ">=", builtin_ge); Interp_add_userfunc(self, "<=", builtin_le); Interp_add_userfunc(self, "not", builtin_not); + Interp_add_userfunc(self, "gcstat", builtin_gcstat); } void Interp_add_userfunc(Interp *interp, const char *name, LispUserFunc fn) { @@ -132,7 +134,72 @@ void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn) { } void Interp_gc(Interp *interp, SExpRef tmproot) { - // TODO + if (!IntVector_empty(&interp->empty_space)) { + return; + } + SExpRefVector gcstack; + SExpRefVector_init(&gcstack); + // add root + SExpRefVector_push_back(&gcstack, tmproot); + SExpRefVector_push_back(&gcstack, interp->nil); + SExpRefVector_push_back(&gcstack, interp->t); + SExpRefVector_push_back(&gcstack, interp->f); + SExpRefVector_push_back(&gcstack, interp->stack); + SExpRefVector_push_back(&gcstack, interp->top_level); + SExpRefVector_push_back(&gcstack, interp->reg); + // mark + while (!SExpRefVector_empty(&gcstack)) { + SExpRef ref = *SExpRefVector_last(&gcstack); + SExpRefVector_pop(&gcstack); + if (ref.idx < 0) continue; + SExp *obj = REF(ref); + if (obj->marked) continue; + obj->marked = true; + if (obj->type == kPairSExp) { + SExpRefVector_push_back(&gcstack, obj->pair.car); + SExpRefVector_push_back(&gcstack, obj->pair.cdr); + } else if (obj->type == kFuncSExp) { + SExpRefVector_push_back(&gcstack, obj->func.args); + SExpRefVector_push_back(&gcstack, obj->func.body); + SExpRefVector_push_back(&gcstack, obj->func.env); + } else if (obj->type == kEnvSExp) { + SExpRefVector_push_back(&gcstack, obj->env.bindings); + SExpRefVector_push_back(&gcstack, obj->env.parent); + } else if (obj->type == kBindingSExp) { + SExpRefVector_push_back(&gcstack, obj->binding.name); + SExpRefVector_push_back(&gcstack, obj->binding.value); + SExpRefVector_push_back(&gcstack, obj->binding.func); + SExpRefVector_push_back(&gcstack, obj->binding.next); + } else if (obj->type == kMacroSExp) { + SExpRefVector_push_back(&gcstack, obj->macro.args); + SExpRefVector_push_back(&gcstack, obj->macro.body); + } + } + SExpRefVector_free(&gcstack); + // sweep + for (int i = 0; i < SExpVector_len(&interp->objs); i++) { + SExp *obj = SExpVector_ref(&interp->objs, i); + if (obj->marked) { + obj->marked = false; + continue; + } + if (obj->type == kSymbolSExp) continue; + if (obj->type == kStringSExp) free((void*)obj->str); + obj->type = kEmptySExp; + IntVector_push_back(&interp->empty_space, i); + } + // enlarge heap + int heapsize = SExpVector_len(&interp->objs); + int usedsize = heapsize - IntVector_len(&interp->empty_space); + if (heapsize < usedsize * 2) { + SExp sexp; + sexp.marked = false; + sexp.type = kEmptySExp; + while (SExpVector_len(&interp->objs) < usedsize * 2) { + SExpVector_push_back(&interp->objs, sexp); + IntVector_push_back(&interp->empty_space, SExpVector_len(&interp->objs) - 1); + } + } } bool lisp_truep(Interp *interp, SExpRef a) { @@ -360,10 +427,12 @@ SExpRef lisp_reverse(Interp *interp, SExpRef lst) { SExpRef lisp_eval_args(Interp *interp, SExpRef args) { SExpRef ret = interp->nil; SExpRef cur = args; + SExpRef evalres; + while (!NILP(cur)) { // save ret in register PUSH_REG(ret); - SExpRef evalres = EVAL(CAR(cur)); + evalres = EVAL(CAR(cur)); POP_REG(); if (ERRORP(evalres)) { ret = evalres; @@ -416,14 +485,15 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) { } SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args) { + SExpRef exp, env, ret, iter; + if (VALTYPE(fn) == kFuncSExp) { - SExpRef env = build_function_env(interp, fn, args); + env = build_function_env(interp, fn, args); if (ERRORP(env)) return env; interp->stack = CONS(env, interp->stack); - SExpRef ret; - SExpRef iter = REF(fn)->func.body; + iter = REF(fn)->func.body; while (!NILP(iter)) { - SExpRef exp = CAR(iter); + exp = CAR(iter); ret = EVAL(exp); if (ERRORP(exp)) goto end; iter = CDR(iter); @@ -432,10 +502,8 @@ SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args) { interp->stack = CDR(interp->stack); return ret; } else if (VALTYPE(fn) == kUserFuncSExp) { - PUSH_REG(args); LispUserFunc fnptr = REF(fn)->userfunc; - SExpRef ret = (*fnptr)(interp, args); - POP_REG(); + ret = (*fnptr)(interp, args); return ret; } error: @@ -493,7 +561,10 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp) { } if (VALTYPE(fn) == kFuncSExp || VALTYPE(fn) == kUserFuncSExp) { SExpRef args = CDR(sexp); - ret = primitive_funcall(interp, CONS(fn, args)); + SExpRef funcallargs = CONS(fn, args); + PUSH_REG(funcallargs); + ret = primitive_funcall(interp, funcallargs); + POP_REG(); goto end; } else if (VALTYPE(fn) == kMacroSExp) { SExpRef args = CDR(sexp); @@ -515,6 +586,7 @@ SExpRef new_sexp(Interp *interp) { if (IntVector_len(&interp->empty_space) == 0) { SExp sexp; sexp.type = kEmptySExp; + sexp.marked = false; SExpVector_push_back(&interp->objs, sexp); return (SExpRef){ SExpVector_len(&interp->objs) - 1 }; } |