more GC stuff

1 files changed, 78 insertions, 44 deletions

diff --git a/pez.c b/pez.c
index ea899a0..2d9527b 100644
--- a/pez.c
+++ b/pez.c
@@ -36,7 +36,7 @@ typedef struct Val {
 }
 
 typedef struct Obj Obj;
-#define OBJHEADER   Obj *next; short t : 8, gc : 1;
+#define OBJHEADER   Obj *next; uint sz; short t : 8, gc : 1;
 
 struct Obj {
     OBJHEADER;
@@ -159,6 +159,8 @@ typedef struct Globals {
 
 enum dbgopts {
     DBGbytecode = 1,
+    DBGstressgc = 2,
+    DBGgcinfo   = 4,
 };
 
 struct PezContext {
@@ -266,10 +268,20 @@ static void *
 cxrealloc(PezContext *cx, void *p, size_t osz, size_t sz)
 {
     void *a = cx->alloc(cx->ud, p, osz, sz);
-    if (a || !p) {
-        cx->nalloc += sz - osz;
+    cx->nalloc += sz - osz;
+    // fprintf(stderr, ">> %+ld\n", sz - osz);
+    if (a || !p || (p && !sz)) {
         assert(cx->nalloc >= 0);
-        if (sz > osz && cx->gccanrun) { gc(cx); };
+        if (sz > osz && cx->gccanrun) {
+            if (cx->dbg & DBGstressgc) {
+                gc(cx);
+            } else if (cx->nalloc >= cx->gcthresh) {
+                gc(cx);
+                cx->gcthresh = cx->nalloc * 2;
+            }
+        };
+    } else if (p && !a && sz > osz) {
+        cx->err = PEZ_ENoMem;
     }
     return a;
 }
@@ -329,7 +341,7 @@ _vecpush(PezContext *cx, void **at, size_t sz,
 /*
 static void
 _vecpop(PezContext *cx, void **at, size_t sz,
-            uint *len, uint *cap) 
+            uint *len, uint *cap)
 {
     uint newcap;
     assert(*len > 0);
@@ -358,13 +370,14 @@ newobj(PezContext *cx, int type, size_t sz)
     o->next = cx->heap;
     cx->heap = o;
     o->t = type;
+    o->sz = sz;
     return o;
 }
 
 static inline bool FORCEINLINE
 push(PezContext *cx, Val v)
 {
-    if (cx->stktop == cx->stkend) {
+    if (cx->stktop >= cx->stkend) {
         cx->err = PEZ_EStack;
         return 0;
     }
@@ -410,7 +423,7 @@ splittable64(uint64_t x)
 
 /***********/
 /* Objects */
-/***********/ 
+/***********/
 
 static Proto *
 newproto(PezContext *cx, const char *file, const char *name, int line)
@@ -486,7 +499,7 @@ globals_lookup(PezContext *cx, Val key, bool put)
         cxfree(cx, pool->dat, sizeof(struct KV) * (pool->N / 2));
         pool->dat = new;
     }
-    
+
     h = splittable64(key.r);
     for (idx = h & (pool->N - 1);; idx = (idx + 1) & (pool->N - 1)) {
         struct KV *kv = &pool->dat[idx];
@@ -590,7 +603,7 @@ box_str(PezContext *cx, Val *pv, const char *s, int len)
         ++cx->strpool.count;
     }
     *pv = box_obj(*slot);
-    return 1;    
+    return 1;
 }
 
 static Array *
@@ -612,10 +625,16 @@ newarr(PezContext *cx, uint cap)
     return arr;
 }
 
+static bool
+arrpushn(PezContext *cx, Array *arr, Val *src, uint n)
+{
+    return n == 0 ? 1 : vecpush(cx, arr, src, n);
+}
+
 static void
 delarray(PezContext *cx, Array *arr)
 {
-    delvec(cx, arr);
+    cxfree(cx, arr->at, arr->cap * sizeof(Val));
 }
 
 static void
@@ -628,12 +647,6 @@ delstring(PezContext *cx, Str *str)
     --cx->strpool.count;
 }
 
-static bool
-arrpushn(PezContext *cx, Array *arr, Val *src, uint n)
-{
-    return n == 0 ? 1 : vecpush(cx, arr, src, n);
-}
-
 /******/
 /* GC */
 /******/
@@ -655,7 +668,7 @@ freeobj(PezContext *cx, Obj *o)
         delstring(cx, (Str *)o);
         break;
     }
-    cxfree(cx, o, sizeof *o);
+    cxfree(cx, o, o->sz);
 }
 
 static void gcmark(PezContext *cx, Obj *o);
@@ -712,7 +725,9 @@ gcmark(PezContext *cx, Obj *o)
 static void
 gc(PezContext *cx)
 {
-    // fprintf(stderr, "GC\n---\n");
+    uint nalloc = cx->nalloc;
+    fprintf(stderr, "--- GC running with %d bytes allocated\n",
+            nalloc);
     for (Val *stk = cx->stack; stk != cx->stktop; ++stk) {
         if (isobj(*stk)) {
             gcmark(cx, unbox_obj(*stk));
@@ -734,9 +749,11 @@ gc(PezContext *cx)
     for (Obj *o = cx->heap, *next, *prev = NULL; o; o = next) {
         next = o->next;
         if (o->gc) {
+            fprintf(stderr, "live %p %s\n", o, typestr(box_obj(o)));
             prev = o;
             o->gc = 0;
         } else {
+            fprintf(stderr, "dead %p %s\n", o, typestr(box_obj(o)));
             // fprintf(stderr, "free %p %s\n", o, typestr(box_obj(o)));
             if (o == cx->heap) {
                 cx->heap = next;
@@ -747,6 +764,10 @@ gc(PezContext *cx)
             freeobj(cx, o);
         }
     }
+    if (cx->dbg & DBGgcinfo) {
+        fprintf(stderr, "--- GC released %d bytes (now %d allocated)\n",
+                nalloc - cx->nalloc, cx->nalloc);
+    }
 }
 
 /********************/
@@ -1034,7 +1055,7 @@ inspectproto(Proto *pr)
             inspectstr(buf, n);
             ip += n;
         }
-        fprintf(stderr, "\n"); 
+        fprintf(stderr, "\n");
     }
     while (n-->1) fputc('-', stderr);
     fprintf(stderr, "\n");
@@ -1258,8 +1279,8 @@ exefn(PezContext *cx, Fn *fn, uint nargs)
             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[-1] = cx->stktop[-2];
+            cx->stktop[-2] = cx->stktop[-3];
             cx->stktop[-3] = v;
         }
         CASE(Ovoid) {
@@ -1308,7 +1329,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs)
             uint8_t idx = code[ip++];
             Val v;
             assert(idx < pr->ncon);
-            v = pr->con[idx];            
+            v = pr->con[idx];
             assert(isobj_of(v, PEZ_TString));
             TRY(push(cx, v));
         }
@@ -1317,7 +1338,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs)
             Val k;
             Fn *fn;
             assert(idx < pr->ncon);
-            k = pr->con[idx];            
+            k = pr->con[idx];
             assert(isobj_of(k, PEZ_TFnProto));
             TRY(fn = newfn(cx, unbox_obj(k)));
             TRY(push(cx, box_obj(fn)));
@@ -1534,7 +1555,7 @@ exefn(PezContext *cx, Fn *fn, uint nargs)
             memcpy(&off, &code[ip], 2), ip += 2;
             dst = ip + off;
             assert(dst < pr->ncode);
-            ip = dst;            
+            ip = dst;
         }
         CASE(Obt) {
             int16_t off;
@@ -1768,7 +1789,7 @@ initcore(PezContext *cx)
         Val s, f;
         TRY(box_str(cx, &s, def->n, strlen(def->n)));
         f = box_cfn(def->f);
-        TRY(putglobal(cx, s, f));        
+        TRY(putglobal(cx, s, f));
     }
     return 1;
 }
@@ -1830,7 +1851,7 @@ comperr(Comp *cm, int ch, const char *fmt, ...)
     vsnprintf(buf, sizeof buf, fmt, ap);
     va_end(ap);
     sprintf(buf2, "'%c'", ch);
-    snprintf(cm->cx->errstr, sizeof cm->cx->errstr, 
+    snprintf(cm->cx->errstr, sizeof cm->cx->errstr,
              "%s:%d:%d: %s (near %s)", cm->proto->file,
              cm->line, cm->col, buf, ch == EOF ? "<EOF>" : buf2);
     cm->cx->errstr[sizeof cm->cx->errstr - 1] = 0;
@@ -2293,7 +2314,7 @@ primaryexpr(Comp *cm)
         num = ftofix(dbl);
         cm->has_k = 1;
         cm->k = box_num(num);
-        return 1;            
+        return 1;
     }
     if (c == '_' || aisalpha(c)) {
         // identifier
@@ -2534,7 +2555,7 @@ prefixexpr(Comp *cm)
         if (cm->has_k && isnum(cm->k)) {
             cm->k = box_num(-(uint32_t)unbox_num(cm->k));
             return 1;
-        } 
+        }
         return compop(cm, Oneg);
     } else if (matchspchr(cm, '!')) {
         TRY(prefixexpr(cm));
@@ -2542,7 +2563,7 @@ prefixexpr(Comp *cm)
         if (cm->has_k) {
             cm->k = box_bool(!truthy(cm->k));
             return 1;
-        } 
+        }
         return compop(cm, Onot);
     } else {
         return postfixexpr(cm);
@@ -2617,7 +2638,7 @@ getbinop(char *kind, char *chr, Comp *cm)
         *chr = nextchr(cm);
         if (matchchr(cm, '<')) {
             *kind = matchchr(cm, '=') ? 'S' : 'A';
-            return Oshl;        
+            return Oshl;
         }
         *kind = 'C';
         if (matchchr(cm, '=')) {
@@ -2728,7 +2749,7 @@ binexpr(Comp *cm, char okind, bool (*prev)(Comp *))
         } else if (has_lk && isimm(&imm, lk) && commutate(&opx)) {
             // when lhs is a constant and the operation can be
             // commutative try use immediate op
-           
+
             // eliminate code generated for lhs
             for (int i = 0; i < save3 - save2; ++i) {
                 memmove(cm->code.at + save + i, cm->code.at + save2 + i, save2 - save);
@@ -3136,7 +3157,7 @@ decl(Comp *cm, Local **pl, bool nofold)
     }
     if (pl) {
        *pl = l;
-    } 
+    }
     if (!cm->has_k || mutable) {
         if (idx > 255) {
             comperr(cm, c, "too many locals");
@@ -3358,7 +3379,7 @@ pez_eval_cb(PezContext *cx, const char *fname, int (*cb)(void *), void *ud)
     }
     if (!(fn = newfn(cx, pr))) {
         delproto(cx, pr);
-        return 0;        
+        return 0;
     }
     initcomp(&cm, cx, pr, cb, ud);
 
@@ -3374,6 +3395,9 @@ pez_eval_cb(PezContext *cx, const char *fname, int (*cb)(void *), void *ud)
     ETRY(exefn(cx, fn, 0));
     cx->stktop[-2] = cx->stktop[-1];
     --cx->stktop; // gc unkeep
+    if (cx->dbg & DBGstressgc) {
+        gc(cx);
+    }
     cx->gccanrun = 0;
 
     deinitcomp(&cm);
@@ -3416,7 +3440,7 @@ mallocator(void *_ud, void *ptr, size_t _oldsize, size_t newsize)
 {
     if (ptr && newsize == 0) {
         free(ptr);
-    } else if (ptr && newsize > 0) {    
+    } else if (ptr && newsize > 0) {
         return realloc(ptr, newsize);
     } else if (!ptr && newsize > 0) {
         return malloc(newsize);
@@ -3424,31 +3448,35 @@ mallocator(void *_ud, void *ptr, size_t _oldsize, size_t newsize)
     return NULL;
 }
 
-#define STACK_SIZE 4096
+// #define STACK_SIZE 4096
 
 PezContext *
-pez_new(PezAllocFn *alloc, void *userdata)
+pez_new(PezAllocFn *alloc, void *userdata, size_t stacksize)
 {
     PezContext *cx;
 
+    stacksize /= sizeof(Val);
     alloc = alloc ? alloc : mallocator;
     cx = alloc(userdata, NULL, 0, sizeof *cx);
     if (!cx) goto Err;
     memset(cx, 0, sizeof *cx);
     cx->alloc = alloc;
     cx->ud = userdata;
-    cx->stack = cxalloc(cx, STACK_SIZE * sizeof(Val));
+    cx->stack = cxalloc(cx, stacksize * sizeof(Val));
     if (!cx->stack) goto Err;
     cx->stktop = cx->stack;
-    cx->stkend = cx->stack + STACK_SIZE;
+    cx->stkend = cx->stack + stacksize;
     if (!box_str(cx, &length_sstr, "length", 6)) assert(0);
     if (!initcore(cx)) goto Err;
 
+    cx->gcthresh = stacksize * sizeof(Val) * 3 + 128;
+
     return cx;
 
 Err:
+    cx->err = PEZ_ENoMem;
     if (cx && cx->stack) {
-        cxfree(cx, cx->stack, sizeof(Val) * STACK_SIZE);
+        cxfree(cx, cx->stack, sizeof(Val) * stacksize);
     }
     if (cx) {
         cxfree(cx, cx, sizeof *cx);
@@ -3464,15 +3492,19 @@ pez_del(PezContext *cx)
         next = o->next;
         freeobj(cx, o);
     }
-    cxfree(cx, cx->stack, STACK_SIZE * sizeof(Val));
+    cxfree(cx, cx->stack, (cx->stkend - cx->stack) * sizeof(Val));
     if (cx->strpool.dat) {
         cxfree(cx, cx->strpool.dat, cx->strpool.N * sizeof(Str *));
     }
     if (cx->globals.dat) {
         cxfree(cx, cx->globals.dat, cx->globals.N * sizeof(struct KV));
     }
-    cxfree(cx, cx, sizeof *cx);
-} 
+    if (cx->nalloc != 0) {
+        fprintf(stderr, "ERR nalloc %d\n", cx->nalloc);
+        assert(cx->nalloc == 0);
+    }
+    cx->alloc(cx->ud, cx, sizeof *cx, 0);
+}
 
 void
 pez_debug(PezContext *cx, const char *opts)
@@ -3482,6 +3514,8 @@ pez_debug(PezContext *cx, const char *opts)
         return;
     }
     if (strchr(opts, 'b')) cx->dbg |= DBGbytecode;
+    if (strchr(opts, 'G')) cx->dbg |= DBGstressgc;
+    if (strchr(opts, 'g')) cx->dbg |= DBGgcinfo;
 }
 
 int
@@ -3494,7 +3528,7 @@ const char *
 pez_geterr(PezContext *cx)
 {
     switch (cx->err) {
-    case PEZ_EStack:   return "stack over/under flow";  
+    case PEZ_EStack:   return "stack overflow";
     case PEZ_ENoMem:   return "out of memory";
     case PEZ_ESyntax:  return cx->errstr;
     case PEZ_ERuntime: return cx->errstr;
@@ -3557,7 +3591,7 @@ pez_pushstring(PezContext *cx, const char *str, int len)
     TRY(box_str(cx, &s, str, len == -1 ? strlen(str) : len));
     return push(cx, s);
 }
-    
+
 bool
 pez_pushglobal(PezContext *cx, const char *name)
 {