From 1ce504148e960fa8fdd3701977786b99a7437f57 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 3 Apr 2012 11:20:41 -0700
Subject: * eval.c (op_modplace): push replaced with mpush (mutating push).

* gc.c (gc_push): New function.

* gc.h (gc_push): Declared.

* hash.c (pushhash): Use mpush.

* lib.c (push): Reverted to unsafe operation. TODO comment replaced
with warning.
(lazy_flatten_scan): push occurence commented as safe.
(lazy_stream_func): Unsafe push replaced with mpush.

* lib.h (mpush): New macro.
---
 ChangeLog | 17 +++++++++++++++++
 eval.c    |  2 +-
 gc.c      |  6 ++++++
 gc.h      |  1 +
 hash.c    |  2 +-
 lib.c     |  9 ++++-----
 lib.h     |  2 ++
 7 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 60553c47..d1831537 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2012-04-03  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (op_modplace): push replaced with mpush (mutating push).
+
+	* gc.c (gc_push): New function.
+
+	* gc.h (gc_push): Declared.
+
+	* hash.c (pushhash): Use mpush.
+
+	* lib.c (push): Reverted to unsafe operation. TODO comment replaced
+	with warning.
+	(lazy_flatten_scan): push occurence commented as safe.
+	(lazy_stream_func): Unsafe push replaced with mpush.
+
+	* lib.h (mpush): New macro.
+
 2012-04-02  Kaz Kylheku  <kaz@kylheku.com>
 
 	* configure: Support a gen-gc configuration variable which
diff --git a/eval.c b/eval.c
index 7ff81ae4..4a44c194 100644
--- a/eval.c
+++ b/eval.c
@@ -983,7 +983,7 @@ static val op_modplace(val form, val env)
     val inc = or2(eval(newform, env, form), one);
     return set(*loc,  minus(*loc, inc));
   } else if (op == push_s) {
-    return push(newval, loc);
+    return mpush(newval, *loc);
   } else if (op == pop_s) {
     if (third_arg_p)
       eval_error(form, lit("~a: superfluous argument"), op, place, nao);
diff --git a/gc.c b/gc.c
index a644be3a..106daa25 100644
--- a/gc.c
+++ b/gc.c
@@ -561,6 +561,12 @@ void gc_mutated(val obj)
     gc();
 }
 
+val gc_push(val obj, val *plist)
+{
+  gc_mutated(obj);
+  return push(obj, plist);
+}
+
 #endif
 
 /*
diff --git a/gc.h b/gc.h
index f82bfd15..8fc83a4e 100644
--- a/gc.h
+++ b/gc.h
@@ -37,6 +37,7 @@ int gc_is_reachable(val);
 
 #if CONFIG_GEN_GC
 val gc_set(val *, val);
+val gc_push(val, val *);
 void gc_mutated(val);
 #endif
 
diff --git a/hash.c b/hash.c
index fa7a6cc7..c45801df 100644
--- a/hash.c
+++ b/hash.c
@@ -415,7 +415,7 @@ val sethash(val hash, val key, val value)
 val pushhash(val hash, val key, val value)
 {
   val new_p;
-  push(value, gethash_l(hash, key, &new_p));
+  mpush(value, *gethash_l(hash, key, &new_p));
   return new_p;
 }
 
diff --git a/lib.c b/lib.c
index 436a47ee..4cef5ba4 100644
--- a/lib.c
+++ b/lib.c
@@ -361,9 +361,8 @@ val pop(val *plist)
 
 val push(val value, val *plist)
 {
-  /* TODO: doing set here is suboptimal since
-     it is often used for just a local var. */
-  return set(*plist, cons(value, *plist));
+  /* Unsafe for mutating object fields: use mpush macro. */
+  return *plist = cons(value, *plist);
 }
 
 val copy_list(val list)
@@ -759,7 +758,7 @@ static val lazy_flatten_scan(val list, val *escape)
       } else if (atom(a)) {
         return list;
       } else do {
-        push(cdr(list), escape);
+        push(cdr(list), escape); /* safe mutation: *escape is a local var */
         list = a;
         a = car(list);
       } while (consp(a));
@@ -3328,7 +3327,7 @@ static val lazy_stream_func(val env, val lcons)
     close_stream(stream, t);
 
   if (ahead)
-    push(ahead, cdr_l(env));
+    mpush(ahead, *cdr_l(env));
 
   return next;
 }
diff --git a/lib.h b/lib.h
index 45bfae30..61af0d45 100644
--- a/lib.h
+++ b/lib.h
@@ -231,9 +231,11 @@ union obj {
 #if CONFIG_GEN_GC
 #define set(place, val) ((place) = (val))
 #define mut(obj)
+#define mpush(val, place) (push(val, &(place)))
 #else
 #define set(place, val) (gc_set(&(place), val))
 #define mut(obj) (gc_mutated(obj));
+#define mpush(val, place) (gc_push(val, &(place)))
 #endif
 
 INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; }
-- 
cgit v1.2.3