From 50cc2134374a49712451bb825afd93e9a4ab54a2 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 24 Dec 2020 13:50:00 -0500
Subject: [PATCH] Issue #430 - Ensure collection of vector fill

Prevent an edge case where the stack object used to fill a large vector is not promoted to the heap.
---
 CHANGELOG.md |  1 +
 runtime.c    | 19 +++++++++++++------
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c4a9144d..2e349e9d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -7,6 +7,7 @@ TODO: shared object functions no longe required since 0.14, update docs to refle
 
 Bug Fixes
 
+- When allocating large vectors the object used to fill such a vector may not be transported to the heap. This was a nasty bug that could lead to memory corruption. 
 - Sean Lynch fixed a bug where record type predicates do not check the length of the target before checking if the vector is actually a record.
 - Do not attempt to call `eval` from the runtime if `(scheme eval)` has not been imported. Instead we now raise a Scheme error in this case instead of allowing the runtime to raise a C segmentation violation.
 
diff --git a/runtime.c b/runtime.c
index e5da978d..4d802eec 100644
--- a/runtime.c
+++ b/runtime.c
@@ -618,9 +618,16 @@ void add_mutation(void *data, object var, int index, object value)
   // No need to track for minor GC purposes unless we are mutating
   // a heap variable to point to a stack var.
   //
-  // If var is on stack we'll get it anyway in minor GC,
-  // and if value is on heap we don't care (no chance of heap pointing to nursery)
-  if (!gc_is_stack_obj(&tmp, data, var) && gc_is_stack_obj(&tmp, data, value)) {
+  // If var is on stack we'll get it anyway in minor GC, and if value 
+  // is on heap we don't care (no chance of heap pointing to nursery)
+  //
+  // There is one special case. For large vectors we use stack objects
+  // as a container to store "real" stack values that must be moved
+  // by the collector. In this case we pass -2 to force collection of
+  // these objects regardless of whether var is on the heap.
+  if ( (!gc_is_stack_obj(&tmp, data, var) && 
+         gc_is_stack_obj(&tmp, data, value)) ||
+       index == -2) {
     thd->mutations = vpbuffer_add(thd->mutations, 
                                   &(thd->mutation_buflen), 
                                   thd->mutation_count, 
@@ -3059,10 +3066,10 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...)
     // Use write barrier to ensure fill is moved to heap if it is on the stack
     // Otherwise if next minor GC misses fill it could be catastrophic
     car(&tmp_pair) = fill;
-    add_mutation(data, &tmp_pair, -1, fill);
+    add_mutation(data, &tmp_pair, -2, fill);
     // Add a special object to indicate full vector must be scanned by GC
     opaque_ptr(&opq) = v;
-    add_mutation(data, &opq, -1, v);
+    add_mutation(data, &opq, -2, v);
   } else {
     v = alloca(sizeof(vector_type));
     ((vector) v)->hdr.mark = gc_color_red;
@@ -3467,7 +3474,7 @@ object Cyc_list2vector(void *data, object cont, object l)
     //add_mutation(data, &tmp_pair, -1, fill);
     // Add a special object to indicate full vector must be scanned by GC
     opaque_ptr(&opq) = v;
-    add_mutation(data, &opq, -1, v);
+    add_mutation(data, &opq, -2, v);
   } else {
     v = alloca(sizeof(vector_type));
     ((vector) v)->hdr.mark = gc_color_red;