GC correctness fixes: make sure we pin down objects for which we borrow

low level C pointers, while we execute code that can cons memory.

* lib.c (list_str): Protect the str argument.
(int_str): Likewise.

* regex.c (search_regex): protect the haystack string,
while using the h pointer to its data, since regex_run
can use the derivative-based engine which conses.

* stream.c (vformat_str): Protect str argument, since
put_char might conceivably cons.
(vformat): Protect fmtstr.

4 files changed, 59 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 1afb5aa2..28131396 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2014-08-25  Kaz Kylheku  <kaz@kylheku.com>
+
+	GC correctness fixes: make sure we pin down objects for which we borrow
+	low level C pointers, while we execute code that can cons memory.
+
+	* lib.c (list_str): Protect the str argument.
+	(int_str): Likewise.
+
+	* regex.c (search_regex): protect the haystack string,
+	while using the h pointer to its data, since regex_run
+	can use the derivative-based engine which conses.
+
+	* stream.c (vformat_str): Protect str argument, since
+	put_char might conceivably cons.
+	(vformat): Protect fmtstr.
+
 2014-08-14  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 96.
diff --git a/lib.c b/lib.c
index e0e98782..a95e68a5 100644
--- a/lib.c
+++ b/lib.c
@@ -2729,8 +2729,14 @@ val list_str(val str)
 {
   const wchar_t *cstr = c_str(str);
   list_collect_decl (out, iter);
+
+  prot1(&str);
+
   while (*cstr)
     iter = list_collect(iter, chr(*cstr++));
+
+  rel1(&str);
+
   return out;
 }
 
@@ -2835,11 +2841,12 @@ val int_str(val str, val base)
     return nil;
 
   if ((value == LONG_MAX || value == LONG_MIN) && errno == ERANGE) {
-    val bignum = make_bignum();
+    val bignum = (prot1(&str), make_bignum());
     unsigned char *ucs = utf8_dup_to_uc(wcs);
     mp_err err = mp_read_radix(mp(bignum), ucs, b);
 
     free(ucs); /* TODO: make wchar_t version of mp_read_radix. */
+    rel1(&str);
 
     if (err != MP_OKAY)
       return nil;
@@ -2850,7 +2857,7 @@ val int_str(val str, val base)
        We do not need this on our usual target platforms, where NUM_MAX is
        never larger than LONG_MAX. */
     return (LONG_MAX < NUM_MAX) ? normalize(bignum) : bignum;
-  } 
+  }
 
   if (value >= NUM_MIN && value <= NUM_MAX)
     return num(value);
diff --git a/regex.c b/regex.c
index 883ebb33..313a1a76 100644
--- a/regex.c
+++ b/regex.c
@@ -39,6 +39,7 @@
 #include "parser.h"
 #include "signal.h"
 #include "unwind.h"
+#include "gc.h"
 #include "regex.h"
 #include "txr.h"
 
@@ -1800,11 +1801,17 @@ val search_regex(val haystack, val needle_regex, val start,
       cnum s = c_num(start);
       const wchar_t *h = c_str(haystack);
 
+      prot1(&haystack);
+
       for (i = c_num(length_str(haystack)) - 1; i >= s; i--) {
         cnum span = regex_run(needle_regex, h + i);
-        if (span >= 0)
+        if (span >= 0) {
+          rel1(&haystack);
           return cons(num(i), num(span));
+        }
       }
+
+      rel1(&haystack);
     } else {
       regex_machine_t regm;
       val i, pos = start, retval;
diff --git a/stream.c b/stream.c
index 2aa5160b..a02fb213 100644
--- a/stream.c
+++ b/stream.c
@@ -1477,21 +1477,28 @@ static val vformat_str(val stream, val str, int width, int left,
   int slack = (truelen < width) ? width - truelen : 0;
   int i;
 
+  prot1(&str);
+
   if (!left)
     for (i = 0; i < slack; i++)
       if (!put_char(chr(' '), stream))
-        return nil;
+        goto nilout;
 
   for (i = 0; i < truelen; i++)
     if (!put_char(chr(cstr[i]), stream))
-      return nil;
+      goto nilout;
 
   if (left)
     for (i = 0; i < slack; i++)
       if (!put_char(chr(' '), stream))
-        return nil;
+        goto nilout;
 
+  rel1(&str);
   return t;
+
+nilout:
+  rel1(&str);
+  return nil;
 }
 
 val vformat(val stream, val fmtstr, va_list vl)
@@ -1500,6 +1507,8 @@ val vformat(val stream, val fmtstr, va_list vl)
   type_assert (stream->co.cls == stream_s, (lit("~a is not a stream"),
                                             stream, nao));
 
+  prot1(&fmtstr);
+
   {
     const wchar_t *fmt = c_str(fmtstr);
     enum {
@@ -1725,7 +1734,7 @@ val vformat(val stream, val fmtstr, va_list vl)
             if (!isdigit(num_buf[0]) && !isdigit(num_buf[1])) {
               if (!vformat_str(stream, lit("#<bad-float>"),
                                width, left, 0))
-                return nil;
+                goto nilout;
               continue;
             }
             precision = 0;
@@ -1786,7 +1795,7 @@ val vformat(val stream, val fmtstr, va_list vl)
             if (!isdigit(num_buf[0]) && !isdigit(num_buf[1])) {
               if (!vformat_str(stream, lit("#<bad-float>"),
                                width, left, 0))
-                return nil;
+                goto nilout;
               continue;
             }
 
@@ -1797,7 +1806,7 @@ val vformat(val stream, val fmtstr, va_list vl)
               val str = format(nil, ch == 'a' ? lit("~a") : lit("~s"),
                                obj, nao);
               if (!vformat_str(stream, str, width, left, precision))
-                return nil;
+                goto nilout;
               continue;
             }
           }
@@ -1821,7 +1830,7 @@ val vformat(val stream, val fmtstr, va_list vl)
             if (pnum != num_buf)
               free(pnum);
             if (!res)
-              return nil;
+              goto nilout;
             continue;
           }
         }
@@ -1834,7 +1843,13 @@ val vformat(val stream, val fmtstr, va_list vl)
 
   if (va_arg(vl, val) != nao)
     internal_error("unterminated format argument list");
+
+  rel1(&fmtstr);
   return t;
+
+nilout:
+  rel1(&fmtstr);
+  return nil;
 premature:
   internal_error("insufficient arguments for format");
 toobig:
@@ -2374,6 +2389,8 @@ static val run(val command, val args)
   args = default_bool_arg(args);
   nargs = c_num(length(args)) + 1;
 
+  prot1(&args);
+
   wargv = (const wchar_t **) chk_malloc((nargs + 2) * sizeof *wargv);
 
   for (i = 0, iter = cons(command, args); iter; i++, iter = cdr(iter))
@@ -2386,6 +2403,8 @@ static val run(val command, val args)
     free((void *) wargv[i]);
   free((void *) wargv);
 
+  rel1(&args);
+
   return (status < 0) ? nil : num(status);
 }
 #else