commit 60e9432784c9c7236d290aa3a9bbc7610aec47b5
parent 805ed50efbe2ee3085c8fcdd026506dacb142eae
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 7 Mar 2011 15:43:21 -0300
Added object freeing on close state. valgring doesn't report any leaks now.
Diffstat:
9 files changed, 93 insertions(+), 11 deletions(-)
diff --git a/src/kapplicative.c b/src/kapplicative.c
@@ -18,9 +18,14 @@ TValue kmake_applicative(klisp_State *K, TValue name, TValue si,
TValue underlying)
{
Applicative *new_app = klispM_new(K, Applicative);
- new_app->next = NULL;
+
+ /* header + gc_fields */
+ new_app->next = K->root_gc;
+ K->root_gc = (GCObject *)new_app;
new_app->gct = 0;
new_app->tt = K_TAPPLICATIVE;
+
+ /* applicative specific fields */
new_app->name = name;
new_app->si = si;
new_app->underlying = underlying;
diff --git a/src/kcontinuation.c b/src/kcontinuation.c
@@ -17,9 +17,14 @@ TValue kmake_continuation(klisp_State *K, TValue parent, TValue name,
va_list argp;
Continuation *new_cont = (Continuation *)
klispM_malloc(K, sizeof(Continuation) + sizeof(TValue) * xcount);
- new_cont->next = NULL;
+
+ /* header + gc_fields */
+ new_cont->next = K->root_gc;
+ K->root_gc = (GCObject *)new_cont;
new_cont->gct = 0;
new_cont->tt = K_TCONTINUATION;
+
+ /* continuation specific fields */
new_cont->mark = KFALSE;
new_cont->name = name;
new_cont->si = si;
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -19,9 +19,14 @@ TValue kmake_environment(klisp_State *K, TValue parent)
{
Environment *new_env = klispM_new(K, Environment);
- new_env->next = NULL;
+
+ /* header + gc_fields */
+ new_env->next = K->root_gc;
+ K->root_gc = (GCObject *) new_env;
new_env->gct = 0;
new_env->tt = K_TENVIRONMENT;
+
+ /* environment specific fields */
new_env->mark = KFALSE;
new_env->parents = parent;
/* TEMP: for now the bindings are an alist */
diff --git a/src/koperative.c b/src/koperative.c
@@ -17,9 +17,14 @@ TValue kmake_operative(klisp_State *K, TValue name, TValue si,
va_list argp;
Operative *new_op = (Operative *)
klispM_malloc(K, sizeof(Operative) + sizeof(TValue) * xcount);
- new_op->next = NULL;
+
+ /* header + gc_fields */
+ new_op->next = K->root_gc;
+ K->root_gc = (GCObject *)new_op;
new_op->gct = 0;
new_op->tt = K_TOPERATIVE;
+
+ /* operative specific fields */
new_op->name = name;
new_op->si = si;
new_op->fn = fn;
diff --git a/src/kpair.c b/src/kpair.c
@@ -14,9 +14,14 @@ TValue kcons(klisp_State *K, TValue car, TValue cdr)
{
Pair *new_pair = klispM_new(K, Pair);
- new_pair->next = NULL;
+ /* header + gc_fields */
+ new_pair->next = K->root_gc;
+ K->root_gc = (GCObject *)new_pair;
new_pair->gct = 0;
new_pair->tt = K_TPAIR;
+
+ /* pair specific fields */
+ new_pair->si = KNIL;
new_pair->mark = KFALSE;
new_pair->car = car;
new_pair->cdr = cdr;
diff --git a/src/kstate.c b/src/kstate.c
@@ -65,7 +65,9 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->filename_out = "*STDOUT*";
/* TODO: more gc info */
- K->totalbytes = KS_ISSIZE + state_size();
+ K->totalbytes = state_size() + KS_ISSIZE * sizeof(TValue) +
+ KS_ITBSIZE;
+ K->root_gc = NULL;
/* TEMP: err */
/* do nothing for now */
@@ -158,9 +160,50 @@ void klispS_run(klisp_State *K)
void klisp_close (klisp_State *K)
{
- /* TODO: free memory for all objects */
- klispM_freemem(K, ks_sbuf(K), ks_ssize(K));
+ /* free all collectable objects */
+ GCObject *next = K->root_gc;
+
+ while(next) {
+ GCObject *obj = next;
+ next = obj->gch.next;
+
+ switch(obj->gch.tt) {
+ case K_TPAIR:
+ klispM_free(K, (Pair *)obj);
+ break;
+ case K_TSYMBOL:
+ klispM_freemem(K, obj, sizeof(Symbol)+obj->sym.size+1);
+ break;
+ case K_TSTRING:
+ klispM_freemem(K, obj, sizeof(String)+obj->str.size+1);
+ break;
+ case K_TENVIRONMENT:
+ klispM_free(K, (Environment *)obj);
+ break;
+ case K_TCONTINUATION:
+ klispM_freemem(K, obj, sizeof(Continuation) +
+ obj->cont.extra_size * sizeof(TValue));
+ break;
+ case K_TOPERATIVE:
+ klispM_freemem(K, obj, sizeof(Operative) +
+ obj->op.extra_size * sizeof(TValue));
+ break;
+ case K_TAPPLICATIVE:
+ klispM_free(K, (Applicative *)obj);
+ break;
+ default:
+ /* shouldn't happen */
+ fprintf(stderr, "Unknown GCObject type: %d\n", obj->gch.tt);
+ abort();
+ }
+ }
+ /* free helper buffers */
+ klispM_freemem(K, ks_sbuf(K), ks_ssize(K) * sizeof(TValue));
klispM_freemem(K, ks_tbuf(K), ks_tbsize(K));
+
+ /* only remaining mem should be of the state struct */
+ assert(K->totalbytes == state_size());
+
/* NOTE: this needs to be done "by hand" */
(*(K->frealloc))(K->ud, K, state_size(), 0);
}
diff --git a/src/kstate.h b/src/kstate.h
@@ -60,6 +60,7 @@ struct klisp_State {
void *ud; /* auxiliary data to `frealloc' */
/* TODO: gc info */
+ GCObject *root_gc; /* list of all collectable objects */
int32_t totalbytes;
/* TEMP: error handling */
diff --git a/src/kstring.c b/src/kstring.c
@@ -18,9 +18,13 @@ TValue kstring_new_empty(klisp_State *K)
new_str = klispM_malloc(K, sizeof(String) + 1);
- new_str->next = NULL;
+ /* header + gc_fields */
+ new_str->next = K->root_gc;
+ K->root_gc = (GCObject *)new_str;
new_str->gct = 0;
new_str->tt = K_TSTRING;
+
+ /* string specific fields */
new_str->mark = KFALSE;
new_str->size = 0;
new_str->b[0] = '\0';
@@ -39,9 +43,13 @@ TValue kstring_new(klisp_State *K, const char *buf, uint32_t size)
new_str = klispM_malloc(K, sizeof(String) + size + 1);
- new_str->next = NULL;
+ /* header + gc_fields */
+ new_str->next = K->root_gc;
+ K->root_gc = (GCObject *)new_str;
new_str->gct = 0;
new_str->tt = K_TSTRING;
+
+ /* string specific fields */
new_str->mark = KFALSE;
new_str->size = size;
/* NOTE: there can be embedded '\0's in a string */
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -31,9 +31,14 @@ TValue ksymbol_new(klisp_State *K, const char *buf)
int32_t size = strlen(buf);
Symbol *new_sym = klispM_malloc(K, sizeof(Symbol) + size + 1);
- new_sym->next = NULL;
+
+ /* header + gc_fields */
+ new_sym->next = K->root_gc;
+ K->root_gc = (GCObject *)new_sym;
new_sym->gct = 0;
new_sym->tt = K_TSYMBOL;
+
+ /* symbol specific fields */
new_sym->mark = KFALSE;
new_sym->size = size;
memcpy(new_sym->b, buf, size);
