aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp.c95
-rw-r--r--src/interp.h2
-rw-r--r--src/sexp.c26
-rw-r--r--src/sexp.h5
4 files changed, 57 insertions, 71 deletions
diff --git a/src/interp.c b/src/interp.c
index b32b2d6..d092e1f 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -359,67 +359,66 @@ void Interp_gc(Interp *interp, SExpRef tmproot) {
if (freesize > (heapsize >> 4) && !interp->alwaysgc) {
return;
}
- SExpRefVector gcstack;
- SExpRefVector_init(&gcstack);
+ SExpPtrVector gcstack;
+ SExpPtrVector_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);
+ SExpPtrVector_push_back(&gcstack, REF(tmproot));
+ SExpPtrVector_push_back(&gcstack, REF(interp->nil));
+ SExpPtrVector_push_back(&gcstack, REF(interp->t));
+ SExpPtrVector_push_back(&gcstack, REF(interp->f));
+ SExpPtrVector_push_back(&gcstack, REF(interp->stack));
+ SExpPtrVector_push_back(&gcstack, REF(interp->top_level));
+ SExpPtrVector_push_back(&gcstack, REF(interp->reg));
// mark
- while (!SExpRefVector_empty(&gcstack)) {
- SExpRef ref = *SExpRefVector_last(&gcstack);
- SExpRef child;
- SExpRefVector_pop(&gcstack);
- if (ref.idx < 0) continue;
- SExp *obj = REF(ref);
+ while (!SExpPtrVector_empty(&gcstack)) {
+ SExpPtr obj = *SExpPtrVector_last(&gcstack);
+ SExpPtr child;
+ SExpPtrVector_pop(&gcstack);
+ if (!obj) continue;
if (obj->marked) continue;
obj->marked = true;
if (obj->type == kPairSExp) {
- child = obj->pair.car;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->pair.cdr;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->pair.car);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->pair.cdr);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
} else if (obj->type == kFuncSExp) {
- child = obj->func.args;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->func.body;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->func.env;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->func.args);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->func.body);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->func.env);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
} else if (obj->type == kEnvSExp) {
- child = obj->env.bindings;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->env.parent;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->env.bindings);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->env.parent);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
} else if (obj->type == kBindingSExp) {
- child = obj->binding.name;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->binding.value;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->binding.func;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->binding.next;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->binding.name);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->binding.value);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->binding.func);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->binding.next);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
} else if (obj->type == kMacroSExp) {
- child = obj->macro.args;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->macro.body;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->macro.args);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->macro.body);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
} else if (obj->type == kReturnSignal) {
- child = obj->ret;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->ret);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
} else if (obj->type == kTailcallSExp) {
- child = obj->tailcall.args;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
- child = obj->tailcall.fn;
- if (child.idx >= 0 && !REF(child)->marked) SExpRefVector_push_back(&gcstack, child);
+ child = REF(obj->tailcall.args);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
+ child = REF(obj->tailcall.fn);
+ if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child);
}
}
- SExpRefVector_free(&gcstack);
+ SExpPtrVector_free(&gcstack);
// sweep
for (int i = 0; i < SExpVector_len(&interp->objs); i++) {
SExp *obj = SExpVector_ref(&interp->objs, i);
diff --git a/src/interp.h b/src/interp.h
index 4e43cd8..515da15 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -44,7 +44,7 @@ void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
SExpRef Interp_eval_string(Interp *interp, const char * str);
SExpRef Interp_load_file(Interp *interp, const char *filename);
-#define REF(_x) (&(interp->objs.buffer)[(_x).idx])
+#define REF(_x) (((_x).idx) >= 0 ? (&(interp->objs.buffer)[(_x).idx]) : NULL)
#define CONS(_x, _y) (lisp_cons(interp, (_x), (_y)))
#define NILP(_x) (lisp_nilp(interp, (_x)))
#define LENGTH(_x) (lisp_length(interp, (_x)))
diff --git a/src/sexp.c b/src/sexp.c
index 5e80d07..d8feb4d 100644
--- a/src/sexp.c
+++ b/src/sexp.c
@@ -3,28 +3,10 @@
#include <inttypes.h>
-void SExpRef_show(SExpRef self, FILE* fp) { }
-
-void SExp_show(SExp self, FILE* fp) {
- if (self.type == kEmptySExp) fprintf(fp, "<EMPTY>");
- else if (self.type == kIntegerSExp) fprintf(fp, "%"PRId64, self.integer);
- else if (self.type == kRealSExp) fprintf(fp, "%lf", self.real);
- else if (self.type == kBooleanSExp) {
- if (self.boolean) fprintf(fp, "#t");
- else fprintf(fp, "#f");
- } else if (self.type == kNilSExp) fprintf(fp, "()");
- else if (self.type == kCharSExp) fprintf(fp, "#\\%c", self.character);
- else if (self.type == kStringSExp) fprintf(fp, "\"%s\"", self.str);
- else if (self.type == kSymbolSExp) fprintf(fp, "'%s", self.str);
- else if (self.type == kUserDataSExp) fprintf(fp, "<%p>", self.userdata);
- else if (self.type == kFuncSExp) fprintf(fp, "<FUNCTION>");
- else if (self.type == kPairSExp) {
- fprintf(fp, "(<%d> . <%d>)", self.pair.car.idx, self.pair.cdr.idx);
- }
- else if (self.type == kEnvSExp) fprintf(fp, "<Env>");
- else if (self.type == kBindingSExp) fprintf(fp, "<BINDING>");
- else if (self.type == kMacroSExp) fprintf(fp, "<MACRO>");
-}
+void SExpRef_show(SExpRef self, FILE* fp) {}
+void SExpPtr_show(SExpPtr self, FILE* fp) {}
+void SExp_show(SExp self, FILE* fp) {}
VECTOR_IMPL(SExp);
VECTOR_IMPL(SExpRef);
+VECTOR_IMPL(SExpPtr);
diff --git a/src/sexp.h b/src/sexp.h
index 1c4016b..4aec76d 100644
--- a/src/sexp.h
+++ b/src/sexp.h
@@ -109,10 +109,15 @@ struct sexp {
};
};
+typedef SExp *SExpPtr;
+
+
void SExp_show(SExp self, FILE* fp);
void SExpRef_show(SExpRef self, FILE* fp);
+void SExpPtr_show(SExpPtr self, FILE* fp);
VECTOR_DEF(SExp);
+VECTOR_DEF(SExpPtr);
#endif
generated by cgit v1.0 at 2025-12-29 17:46:41 +0000