properly reset pic->ai

lib/error.c

@@ -37,7 +37,7 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
 PIC_JMPBUF *
 pic_prepare_try(pic_state *pic)
 {
-  struct context *cxt = pic_alloca(pic, sizeof(struct context));
+  struct context *cxt = pic_malloc(pic, sizeof(struct context));
 
   cxt->pc = NULL;
   cxt->fp = NULL;
@@ -65,6 +65,7 @@ pic_enter_try(pic_state *pic)
 {
   pic_value cont, handler;
   pic_value var, env;
+  size_t ai = pic_enter(pic);
 
   /* call/cc */
   cont = pic_make_cont(pic, pic->cxt, pic_invalid_value(pic), pic->dyn_env);
@@ -74,19 +75,26 @@ pic_enter_try(pic_state *pic)
   env = pic_make_weak(pic);
   pic_weak_set(pic, env, var, pic_cons(pic, handler, pic_call(pic, var, 0)));
   pic->dyn_env = pic_cons(pic, env, pic->dyn_env);
+
+  pic_leave(pic, ai);
 }
 
 void
 pic_exit_try(pic_state *pic)
 {
+  struct context *cxt = pic->cxt;
   pic->dyn_env = pic_cdr(pic, pic->dyn_env);
-  pic->cxt = pic->cxt->prev;
+  pic->cxt = cxt->prev;
+  pic_free(pic, cxt);
 }
 
 pic_value
 pic_abort_try(pic_state *pic)
 {
-  pic_value err = pic->cxt->sp->regs[1];
+  struct context *cxt = pic->cxt;
+  pic_value err = cxt->sp->regs[1];
+  pic->cxt = pic->cxt->prev;
+  pic_free(pic, cxt);
   pic_protect(pic, err);
   return err;
 }

lib/gc.c

@@ -185,7 +185,7 @@ pic_alloca(pic_state *pic, size_t n)
 /* MARK */
 
 PIC_STATIC_INLINE bool
-is_marked(struct object *obj)
+is_alive(struct object *obj)
 {
   return obj->u.basic.tt & GC_MARK;
 }
@@ -211,7 +211,7 @@ gc_mark_object(pic_state *pic, struct object *obj)
 {
  loop:
 
-  if (is_marked(obj))
+  if (is_alive(obj))
     return;
 
   mark(obj);
@@ -366,8 +366,8 @@ gc_mark_phase(pic_state *pic)
           continue;
         key = kh_key(h, it);
         val = kh_val(h, it);
-        if (is_marked(key)) {
-          if (obj_p(pic, val) && ! is_marked(obj_ptr(pic, val))) {
+        if (is_alive(key)) {
+          if (obj_p(pic, val) && ! is_alive(obj_ptr(pic, val))) {
             gc_mark(pic, val);
             ++j;
           }
@@ -612,7 +612,7 @@ gc_sweep_phase(pic_state *pic)
       if (! kh_exist(h, it))
         continue;
       obj = kh_key(h, it);
-      if (! is_marked(obj)) {
+      if (! is_alive(obj)) {
         kh_del(weak, h, it);
       }
     }
@@ -624,7 +624,7 @@ gc_sweep_phase(pic_state *pic)
     if (! kh_exist(s, it))
       continue;
     sym = kh_val(s, it);
-    if (sym && ! is_marked((struct object *)sym)) {
+    if (sym && ! is_alive((struct object *)sym)) {
       kh_del(oblist, s, it);
     }
   }
@@ -657,6 +657,10 @@ pic_obj_alloc_unsafe(pic_state *pic, int type)
 {
   struct object *obj;
 
+  if (pic->heap->pages == NULL) {
+    heap_morecore(pic);
+  }
+
 #if GC_STRESS
   pic_gc(pic);
 #endif
@@ -665,12 +669,8 @@ pic_obj_alloc_unsafe(pic_state *pic, int type)
   if (obj == NULL) {
     pic_gc(pic);
     obj = obj_alloc(pic, type);
-    if (obj == NULL) {
-      heap_morecore(pic);
-      obj = obj_alloc(pic, type);
-      if (obj == NULL)
-	pic_panic(pic, "GC memory exhausted");
-    }
+    if (obj == NULL)
+      pic_panic(pic, "GC memory exhausted");
   }
 
   return obj;

lib/include/picrin.h

@@ -311,6 +311,7 @@ PIC_NORETURN void pic_error(pic_state *, const char *msg, int n, ...);
 #define pic_catch(e) pic_catch_(e, PIC_GENSYM(label))
 #define pic_catch_(e, label)                              \
       pic_exit_try(pic);                                  \
+      /* don't rewind ai here */                          \
     } else {                                              \
       e = pic_abort_try(pic);                             \
       pic_leave(pic, pic_try_ai_);                        \

lib/proc.c

@@ -347,13 +347,17 @@ pic_call(pic_state *pic, pic_value proc, int n, ...)
 pic_value
 pic_vcall(pic_state *pic, pic_value proc, int n, va_list ap)
 {
+  size_t ai = pic_enter(pic);
   pic_value *args = pic_alloca(pic, sizeof(pic_value) * n);
+  pic_value r;
   int i;
 
   for (i = 0; i < n; ++i) {
     args[i] = va_arg(ap, pic_value);
   }
-  return pic_apply(pic, proc, n, args);
+  r = pic_apply(pic, proc, n, args);
+  pic_leave(pic, ai);
+  return pic_protect(pic, r);
 }
 
 pic_value

lib/state.c

@@ -294,13 +294,18 @@ pic_global_set(pic_state *pic, pic_value sym, pic_value value)
 pic_value
 pic_ref(pic_state *pic, const char *name)
 {
-  return pic_global_ref(pic, pic_intern_cstr(pic, name));
+  size_t ai = pic_enter(pic);
+  pic_value r = pic_global_ref(pic, pic_intern_cstr(pic, name));
+  pic_leave(pic, ai);
+  return pic_protect(pic, r);
 }
 
 void
 pic_set(pic_state *pic, const char *name, pic_value val)
 {
+  size_t ai = pic_enter(pic);
   pic_global_set(pic, pic_intern_cstr(pic, name), val);
+  pic_leave(pic, ai);
 }
 
 void
@@ -329,6 +334,7 @@ pic_defvar(pic_state *pic, const char *name, pic_value init)
 pic_value
 pic_funcall(pic_state *pic, const char *name, int n, ...)
 {
+  size_t ai = pic_enter(pic);
   pic_value proc, r;
   va_list ap;
 
@@ -340,5 +346,6 @@ pic_funcall(pic_state *pic, const char *name, int n, ...)
   r = pic_vcall(pic, proc, n, ap);
   va_end(ap);
 
-  return r;
+  pic_leave(pic, ai);
+  return pic_protect(pic, r);
 }

tools/mkloader.pl

@@ -17,6 +17,7 @@ print <<EOL;
 void
 pic_eval_native(pic_state *pic, const char *str)
 {
+  size_t ai = pic_enter(pic);
   pic_value port = pic_fmemopen(pic, str, strlen(str), "r"), e;
 
   pic_try {
@@ -35,6 +36,7 @@ pic_eval_native(pic_state *pic, const char *str)
     pic_raise(pic, e);
   }
   pic_fclose(pic, port);
+  pic_leave(pic, ai);
 }
 
 EOL