klisp

commit fdd7793625c903ecf7b71270a08b1bf00b44bf8f
parent 19a825226ecb40b76fb12936beb0f3e963f13c0c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 16 Apr 2011 11:35:00 -0300

Added gc rooting to kgcontrol.

Diffstat:
M
src/kgcontrol.c
 | 
46
+++++++++++++++++++++++++++++++++++-----------

1 file changed, 35 insertions(+), 11 deletions(-)
diff --git a/src/kgcontrol.c b/src/kgcontrol.c
@@ -44,7 +44,7 @@ void Sif(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     ** in the last evaluation in the common use of ($if ($or?/$and? ...) ...) 
     */
     kset_bool_check_cont(new_cont);
-    klispS_set_cc(K, new_cont);
+    kset_cc(K, new_cont);
     ktail_eval(K, test, denv);
 }
 
@@ -68,7 +68,7 @@ void select_clause(klisp_State *K, TValue *xparams, TValue obj)
 /* 5.1.1 $sequence */
 void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 {
-    (void) xparams;
+    UNUSED(xparams);
 
     if (ttisnil(ptree)) {
 	kapply_cc(K, KINERT);
@@ -82,9 +82,11 @@ void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 	   allow used from $lambda, $vau, $let family, load, etc */
 	TValue tail = kcdr(ls);
 	if (ttispair(tail)) {
+	    krooted_tvs_push(K, ls);
 	    TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
 					     do_seq, 2, tail, denv);
 	    kset_cc(K, new_cont);
+	    krooted_tvs_pop(K);
 	} 
 	ktail_eval(K, kcar(ls), denv);
     }
@@ -121,13 +123,12 @@ void do_seq(klisp_State *K, TValue *xparams, TValue obj)
 ** on $sequence, cf. $let, $vau and $lambda)
 ** Throw errors if any of the above mentioned checks fail.
 */
+/* GC: assumes clauses is rooted, uses dummy 1 & 2 */
 TValue split_check_cond_clauses(klisp_State *K, TValue clauses, 
 				TValue *bodies)
 {
-    TValue dummy_cars = kcons(K, KNIL, KNIL);
-    TValue last_car_pair = dummy_cars;
-    TValue dummy_cdrs = kcons(K, KNIL, KNIL);
-    TValue last_cdr_pair = dummy_cdrs;
+    TValue last_car_pair = kget_dummy1(K);
+    TValue last_cdr_pair = kget_dummy2(K);
 
     TValue tail = clauses;
     int32_t count = 0;
@@ -137,6 +138,8 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
 	TValue first = kcar(tail);
 	if (!ttispair(first)) {
 	    unmark_list(K, clauses);
+	    UNUSED(kcutoff_dummy1(K));
+	    UNUSED(kcutoff_dummy2(K));
 	    klispE_throw(K, "$cond: bad structure in clauses");
 	    return KNIL;
 	}
@@ -161,27 +164,39 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses,
     }
 
     unmark_list(K, clauses);
-
+    
     if (!ttispair(tail) && !ttisnil(tail)) {
+	UNUSED(kcutoff_dummy1(K));
+	UNUSED(kcutoff_dummy2(K));
 	klispE_throw(K, "$cond: expected list (clauses)");
 	return KNIL;
     } else {
 
-	tail = kcdr(dummy_cdrs);
+	TValue cars = kcutoff_dummy1(K);
+	TValue cdrs = kcutoff_dummy2(K);
+	/* check copy list could throw an error
+	   and leave the dummys full, use tvs_push instead */
+	krooted_tvs_push(K, cars);
+	krooted_tvs_push(K, cdrs);
+
 	/* 
 	   check all the bodies (should be lists), and
 	   make a copy of the list structure.
 	   couldn't be done before because this uses
 	   marks, count is used because it may be a cyclic list
 	*/
+	tail = cdrs;
 	while(count--) {
 	    TValue first = kcar(tail);
 	    TValue copy = check_copy_list(K, "$cond", first, false);
 	    kset_car(tail, copy);
 	    tail = kcdr(tail);
 	}
-	*bodies = kcdr(dummy_cdrs);
-	return kcdr(dummy_cars);
+	krooted_tvs_pop(K);
+	krooted_tvs_pop(K);
+
+	*bodies = cdrs;
+	return cars;
     }
 }
 
@@ -242,7 +257,8 @@ void Scond(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 
     TValue bodies;
     TValue tests = split_check_cond_clauses(K, ptree, &bodies);
-
+    krooted_tvs_push(K, tests);
+    
     TValue obj;
     if (ttisnil(tests)) {
 	obj = KINERT;
@@ -258,6 +274,8 @@ void Scond(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 	kset_cc(K, new_cont);
 	obj = KFALSE; 
     }
+
+    krooted_tvs_pop(K);
     kapply_cc(K, obj);
 }
 
@@ -286,13 +304,16 @@ void do_for_each(klisp_State *K, TValue *xparams, TValue obj)
 	/* XXX: no check necessary, could just use copy_list if there
 	 was such a procedure */
 	TValue first_ptree = check_copy_list(K, "for-each", kcar(ls), false);
+	krooted_tvs_push(K, first_ptree);
 	ls = kcdr(ls);
 	n = n-1;
+
 	/* have to unwrap the applicative to avoid extra evaluation of first */
 	TValue new_expr = kcons(K, kunwrap(app), first_ptree);
 	TValue new_cont = 
 	    kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_for_each, 4, 
 			       app, ls, i2tv(n), denv);
+	krooted_tvs_pop(K);
 	kset_cc(K, new_cont);
 	ktail_eval(K, new_expr, denv);
     }
@@ -324,12 +345,15 @@ void for_each(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     lss = map_for_each_transpose(K, lss, app_apairs, app_cpairs, 
 				 res_apairs, res_cpairs);
 
+    krooted_tvs_push(K, lss);
+
     /* schedule all elements at once, the cycle is just ignored, this
        will also return #inert once done. */
     TValue new_cont = 
 	kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_for_each, 4, app, lss,
 			   i2tv(res_pairs), denv);
     kset_cc(K, new_cont);
+    krooted_tvs_pop(K);
     /* this will be a nop */
     kapply_cc(K, KINERT);
 }