$NetBSD$

Patches for cyclone issue 560
https://github.com/justinethier/cyclone/compare/master...issue-560-compute-stack-limit
https://github.com/justinethier/cyclone/pull/561

--- include/cyclone/runtime.h
+++ include/cyclone/runtime.h
@@ -47,6 +47,8 @@ extern const object Cyc_RECORD_MARKER;
  */
 void GC(void *, closure, object *, int);
 
+int Cyc_stack_remaining(gc_thread_data *td);
+
 /**
  * \ingroup gc_major
  */
--- include/cyclone/types.h
+++ include/cyclone/types.h
@@ -500,6 +500,13 @@ void Cyc_make_shared_object(void *data, object k, object obj);
 #define stack_overflow(x,y) ((x) > (y))
 #endif
 
+/** Determine remaining stack size */
+#if STACK_GROWTH_IS_DOWNWARD
+#define stack_delta(x,y) (((char *)x) - ((char *)y))
+#else
+#define stack_delta(x,y) (((char *)y) - ((char *)x))
+#endif
+
 /**
  * Access an object's forwarding pointer.
  * Note this is only applicable when objects are relocated
@@ -998,10 +1005,13 @@ typedef struct {
  * Allocate a new string, either on the stack or heap depending upon size
  */
 #define alloc_string(_data, _s, _len, _num_cp) \
-  if (_len >= MAX_STACK_OBJ) { \
+ { \
+  int stack_left = Cyc_stack_remaining(data); \
+  int alloc_required = sizeof(string_type) + _len + 1; \
+  if (alloc_required >= stack_left) { \
     int heap_grown; \
     _s = gc_alloc(((gc_thread_data *)data)->heap,  \
-                 sizeof(string_type) + _len + 1, \
+                 alloc_required, \
                  boolean_f, /* OK to populate manually over here */ \
                  (gc_thread_data *)data,  \
                  &heap_grown); \
@@ -1021,16 +1031,20 @@ typedef struct {
     ((string_type *)_s)->len = _len; \
     ((string_type *)_s)->num_cp = _num_cp; \
     ((string_type *)_s)->str = alloca(sizeof(char) * (_len + 1)); \
-  }
+  } \
+ }
 
 /**
  * Allocate a new bytevector, either on the stack or heap depending upon size
  */
 #define alloc_bytevector(_data, _bv, _len) \
-  if (_len >= MAX_STACK_OBJ) { \
+ { \
+  int stack_left = Cyc_stack_remaining(data); \
+  int alloc_required = sizeof(bytevector_type) + _len; \
+  if (alloc_required >= stack_left) { \
     int heap_grown; \
     _bv = gc_alloc(((gc_thread_data *)data)->heap, \
-                  sizeof(bytevector_type) + _len, \
+                  alloc_required, \
                   boolean_f, /* OK to populate manually over here */ \
                   (gc_thread_data *)data, \
                   &heap_grown); \
@@ -1048,7 +1062,8 @@ typedef struct {
     ((bytevector) _bv)->tag = bytevector_tag; \
     ((bytevector) _bv)->len = _len; \
     ((bytevector) _bv)->data = alloca(sizeof(char) * _len); \
-  }
+  } \
+ }
 
 /** Get the length of a string, in characters (code points) */
 #define string_num_cp(x) (((string_type *) x)->num_cp)
--- runtime.c
+++ runtime.c
@@ -2799,10 +2799,18 @@ void dispatch_string_91append(void *data, object clo, int _argc, object * _args)
 {
   int argc = _argc - 1;         // Skip continuation
   object *args = _args + 1;     // Skip continuation
-  int i = 0, total_cp = 0, total_len = 1;
+  int i = 0, total_cp = 0, total_len = 0;
   int *len = alloca(sizeof(int) * argc);
-  char *buffer, *bufferp, **str = alloca(sizeof(char *) * argc);
-  object tmp;
+  char *bufferp, **str = alloca(sizeof(char *) * argc);
+  object tmp, result;
+  if (argc == 0) {
+    make_string(r, "");
+    return_closcall1(data, clo, &r);
+  }
+  if (argc == 1) {
+    Cyc_check_str(data, args[0]);
+    return_closcall1(data, clo, args[0]);
+  }
   for (i = 0; i < argc; i++) {
     tmp = args[i];
     Cyc_check_str(data, tmp);
@@ -2811,32 +2819,39 @@ void dispatch_string_91append(void *data, object clo, int _argc, object * _args)
     total_len += len[i];
     total_cp += string_num_cp((tmp));
   }
-  buffer = bufferp = alloca(sizeof(char) * total_len);
+  alloc_string(data, result, sizeof(char) * total_len, total_cp);
+  bufferp = ((string_type *) result)->str;
   for (i = 0; i < argc; i++) {
     memcpy(bufferp, str[i], len[i]);
     bufferp += len[i];
   }
   *bufferp = '\0';
-  make_string(result, buffer);
-  string_num_cp((&result)) = total_cp;
-  return_closcall1(data, clo, &result);
+  return_closcall1(data, clo, result);
 }
 
 object Cyc_string_append(void *data, object cont, int argc, object str1, ...)
 {
+  int i = 0, total_cp = 0, total_len = 0;
+  int *len;
+  char *bufferp, **str;
+  object tmp, result;
   va_list ap;
-  va_start(ap, str1);
-  int i = 0, total_cp = 0, total_len = 1;
-  int *len = alloca(sizeof(int) * argc);
-  char *buffer, *bufferp, **str = alloca(sizeof(char *) * argc);
-  object tmp;
-  if (argc > 0) {
+  if (argc == 0) {
+    make_string(r, "");
+    _return_closcall1(data, cont, &r);
+  }
+  if (argc == 1) {
     Cyc_check_str(data, str1);
-    str[i] = ((string_type *) str1)->str;
-    len[i] = string_len((str1));
-    total_len += len[i];
-    total_cp += string_num_cp((str1));
+    _return_closcall1(data, cont, str1);
   }
+  len = alloca(sizeof(int) * argc);
+  str = alloca(sizeof(char *) * argc);
+  va_start(ap, str1);
+  Cyc_check_str(data, str1);
+  str[i] = ((string_type *) str1)->str;
+  len[i] = string_len((str1));
+  total_len += len[i];
+  total_cp += string_num_cp((str1));
   for (i = 1; i < argc; i++) {
     tmp = va_arg(ap, object);
     Cyc_check_str(data, tmp);
@@ -2845,16 +2860,15 @@ object Cyc_string_append(void *data, object cont, int argc, object str1, ...)
     total_len += len[i];
     total_cp += string_num_cp((tmp));
   }
-  buffer = bufferp = alloca(sizeof(char) * total_len);
+  alloc_string(data, result, sizeof(char) * total_len, total_cp);
+  bufferp = ((string_type *) result)->str;
   for (i = 0; i < argc; i++) {
     memcpy(bufferp, str[i], len[i]);
     bufferp += len[i];
   }
   *bufferp = '\0';
-  make_string(result, buffer);
-  string_num_cp((&result)) = total_cp;
   va_end(ap);
-  _return_closcall1(data, cont, &result);
+  _return_closcall1(data, cont, result);
 }
 
 object Cyc_string_length(void *data, object str)
@@ -3171,7 +3185,7 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...)
   object v = NULL;
   object fill = boolean_f;
   int i, ulen;
-  size_t element_vec_size;
+  size_t element_vec_size, alloc_required;
   va_list ap;
   make_pair(tmp_pair, NULL, NULL);
   make_c_opaque(opq, NULL);
@@ -3183,14 +3197,15 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...)
   Cyc_check_num(data, len);
   ulen = unbox_number(len);
   element_vec_size = sizeof(object) * ulen;
+  alloc_required = sizeof(vector_type) + element_vec_size;
 
-  if (element_vec_size >= MAX_STACK_OBJ) {
+  if (alloc_required >= Cyc_stack_remaining(data)) {
     // If vector is too large to allocate on the stack, allocate on heap
     //
     // TODO: mark this thread as potentially blocking before doing
     //       the allocation????
     int heap_grown;
-    v = gc_alloc(((gc_thread_data *) data)->heap, sizeof(vector_type) + element_vec_size, boolean_f,    // OK to populate manually over here
+    v = gc_alloc(((gc_thread_data *) data)->heap, alloc_required, boolean_f,    // OK to populate manually over here
                  (gc_thread_data *) data, &heap_grown);
     ((vector) v)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
     ((vector) v)->hdr.grayed = 0;
@@ -3243,7 +3258,7 @@ object Cyc_make_bytevector(void *data, object cont, int argc, object len, ...)
   Cyc_check_num(data, len);
   length = unbox_number(len);
 
-  if (length >= MAX_STACK_OBJ) {
+  if (length >= Cyc_stack_remaining(data)) {
     int heap_grown;
     bv = gc_alloc(((gc_thread_data *) data)->heap, sizeof(bytevector_type) + length, boolean_f, // OK to populate manually over here
                   (gc_thread_data *) data, &heap_grown);
@@ -3327,11 +3342,18 @@ void dispatch_bytevector_91append(void *data, object clo, int _argc,
   int argc = _argc - 1;         // Skip continuation
   object *args = _args + 1;     // Skip continuation
   int i = 0, buf_idx = 0, total_length = 0;
-  object tmp;
+  object tmp, result;
   char *buffer;
   char **buffers = NULL;
   int *lengths = NULL;
-  make_empty_bytevector(result);
+  if (argc == 0) {
+    make_empty_bytevector(r);
+    return_closcall1(data, clo, &r);
+  }
+  if (argc == 1) {
+    Cyc_check_bvec(data, args[0]);
+    return_closcall1(data, clo, args[0]);
+  }
   if (argc > 0) {
     buffers = alloca(sizeof(char *) * argc);
     lengths = alloca(sizeof(int) * argc);
@@ -3342,26 +3364,32 @@ void dispatch_bytevector_91append(void *data, object clo, int _argc,
       lengths[i] = ((bytevector) tmp)->len;
       buffers[i] = ((bytevector) tmp)->data;
     }
-    buffer = alloca(sizeof(char) * total_length);
+    alloc_bytevector(data, result, total_length);
+    buffer = ((bytevector) result)->data;
     for (i = 0; i < argc; i++) {
       memcpy(&buffer[buf_idx], buffers[i], lengths[i]);
       buf_idx += lengths[i];
     }
-    result.len = total_length;
-    result.data = buffer;
   }
-  return_closcall1(data, clo, &result);
+  return_closcall1(data, clo, result);
 }
 
 object Cyc_bytevector_append(void *data, object cont, int argc, object bv, ...)
 {
   int i = 0, buf_idx = 0, total_length = 0;
   va_list ap;
-  object tmp;
+  object tmp, result;
   char *buffer;
   char **buffers = NULL;
   int *lengths = NULL;
-  make_empty_bytevector(result);
+  if (argc == 0) {
+    make_empty_bytevector(r);
+    _return_closcall1(data, cont, &r);
+  }
+  if (argc == 1) {
+    Cyc_check_bvec(data, bv);
+    _return_closcall1(data, cont, bv);
+  }
   if (argc > 0) {
     buffers = alloca(sizeof(char *) * argc);
     lengths = alloca(sizeof(int) * argc);
@@ -3378,15 +3406,14 @@ object Cyc_bytevector_append(void *data, object cont, int argc, object bv, ...)
       buffers[i] = ((bytevector) tmp)->data;
     }
     va_end(ap);
-    buffer = alloca(sizeof(char) * total_length);
+    alloc_bytevector(data, result, total_length);
+    buffer = ((bytevector) result)->data;
     for (i = 0; i < argc; i++) {
       memcpy(&buffer[buf_idx], buffers[i], lengths[i]);
       buf_idx += lengths[i];
     }
-    result.len = total_length;
-    result.data = buffer;
   }
-  _return_closcall1(data, cont, &result);
+  _return_closcall1(data, cont, result);
 }
 
 object Cyc_bytevector_copy(void *data, object cont, object bv, object start,
@@ -3411,7 +3438,7 @@ object Cyc_bytevector_copy(void *data, object cont, object bv, object start,
     Cyc_rt_raise2(data, "bytevector-copy - invalid end", end);
   }
 
-  if (len >= MAX_STACK_OBJ) {
+  if (len >= Cyc_stack_remaining(data)) {
     int heap_grown;
     object result = gc_alloc(((gc_thread_data *) data)->heap,
                              sizeof(bytevector_type) + len,
@@ -3495,7 +3522,7 @@ object Cyc_string2utf8(void *data, object cont, object str, object start,
   }
   // Fast path
   if (string_num_cp(str) == string_len(str)) {
-    if (len >= MAX_STACK_OBJ) {
+    if (len >= Cyc_stack_remaining(data)) {
       int heap_grown;
       object bv = gc_alloc(((gc_thread_data *) data)->heap,
                            sizeof(bytevector_type) + len,
@@ -3540,7 +3567,7 @@ object Cyc_string2utf8(void *data, object cont, object str, object start,
       }
     }
     len = end_i - start_i;
-    if (len >= MAX_STACK_OBJ) {
+    if (len >= Cyc_stack_remaining(data)) {
       int heap_grown;
       object bv = gc_alloc(((gc_thread_data *) data)->heap,
                            sizeof(bytevector_type) + len,
@@ -3622,16 +3649,17 @@ object Cyc_list2vector(void *data, object cont, object l)
   object len_obj;
   object lst = l;
   int len, i = 0;
-  size_t element_vec_size;
+  size_t element_vec_size, alloc_required;
 
   make_c_opaque(opq, NULL);
   Cyc_check_pair_or_null(data, l);
   len_obj = Cyc_length(data, l);
   len = obj_obj2int(len_obj);
   element_vec_size = sizeof(object) * len;
-  if (element_vec_size >= MAX_STACK_OBJ) {
+  alloc_required = sizeof(vector_type) + element_vec_size;
+  if (alloc_required >= Cyc_stack_remaining(data)) {
     int heap_grown;
-    v = gc_alloc(((gc_thread_data *) data)->heap, sizeof(vector_type) + element_vec_size, boolean_f,    // OK to populate manually over here
+    v = gc_alloc(((gc_thread_data *) data)->heap, alloc_required, boolean_f,    // OK to populate manually over here
                  (gc_thread_data *) data, &heap_grown);
     ((vector) v)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
     ((vector) v)->hdr.grayed = 0;
@@ -8930,3 +8958,11 @@ object Cyc_exact_no_cps(void *data, object ptr, object z)
   }
   return obj_int2obj(i);
 }
+
+int Cyc_stack_remaining(gc_thread_data *td) 
+{
+  int i;
+  int stack_remaining = stack_delta(&i, td->stack_limit);
+  //printf("JAE DEBUG stack remaining = %ld\n", stack_remaining);
+  return stack_remaining;
+}
--- scheme/base.sld
+++ scheme/base.sld
@@ -1132,7 +1132,8 @@
         }
         num_cp = obj_obj2int(count);
         len = num_cp * buflen;
-        if (len >= MAX_STACK_OBJ) {
+        int stack_left = Cyc_stack_remaining(data);
+        if (len >= stack_left) {
           int heap_grown;
           s = gc_alloc(((gc_thread_data *)data)->heap, 
                        sizeof(string_type) + len + 1,