From 06bd10fd45dc008fe0ea4909254b2e951e715809 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 1 Mar 2024 23:15:26 -0800
Subject: mapcar: avoid alloca proportional to number of args.

* eval.c (MAP_ALLOCA_LIMIT): New preprocessor symbol.
(map_common): If the number of args is greater than
MAP_ALLOCA_LIMIT, then allocate the array of seq_iter_t
structures from chk_malloc rather than alloca.
In case an exception might be thrown during the execution
of this function, we bind that memory to a buf object.
If we return normally, we call the new function buf_free
to release it. Otherwise we rely on the garbage collector.

* buf.[ch] (buf_free): New function.

* tests/012/seq.tl: Test case which hits this behavior.
---
 buf.c            | 13 +++++++++++++
 buf.h            |  1 +
 eval.c           | 18 ++++++++++++++++--
 tests/012/seq.tl |  3 +++
 4 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/buf.c b/buf.c
index 07322788..cc3bcda6 100644
--- a/buf.c
+++ b/buf.c
@@ -227,6 +227,19 @@ val buf_set_length(val buf, val len, val init_val)
   return buf_do_set_len(buf, b, len, init_val, self);
 }
 
+val buf_free(val buf)
+{
+  val self = lit("buf-free");
+  struct buf *b = buf_handle(buf, self);
+  if (b->size) {
+    free(b->data);
+    b->data = 0;
+    b->len = b->size = zero;
+    return t;
+  }
+  return nil;
+}
+
 val length_buf(val buf)
 {
   val self = lit("length-buf");
diff --git a/buf.h b/buf.h
index 8d2733ce..3d2ebc01 100644
--- a/buf.h
+++ b/buf.h
@@ -35,6 +35,7 @@ val make_duplicate_buf(val len, mem_t *data);
 val copy_buf(val buf);
 val buf_trim(val buf);
 val buf_set_length(val obj, val len, val init_val);
+val buf_free(val buf);
 val length_buf(val buf);
 val buf_alloc_size(val buf);
 mem_t *buf_get(val buf, val self);
diff --git a/eval.c b/eval.c
index cd87c3a9..e6edb5a0 100644
--- a/eval.c
+++ b/eval.c
@@ -57,11 +57,18 @@
 #include "filter.h"
 #include "tree.h"
 #include "vm.h"
+#include "buf.h"
 #include "eval.h"
 
 #define max(a, b) ((a) > (b) ? (a) : (b))
 #define min(a, b) ((a) < (b) ? (a) : (b))
 
+#if CONFIG_SMALL_MEM
+#define MAP_ALLOCA_LIMIT   1024
+#else
+#define MAP_ALLOCA_LIMIT   4096
+#endif
+
 typedef val (*opfun_t)(val, val);
 
 struct c_var {
@@ -5776,9 +5783,13 @@ static val map_common(val self, val fun, varg lists,
     return map_fn(fun, args_atz(lists, 0));
   } else {
     cnum i, idx, argc = args_count(lists, self);
+    int over_limit = (argc > MAP_ALLOCA_LIMIT);
     val arg0 = args_at(lists, 0);
     seq_iter_t *iter_array = coerce(seq_iter_t *,
-                                    alloca(argc * sizeof *iter_array));
+                                    if3(over_limit,
+                                        chk_malloc(argc * sizeof *iter_array),
+                                        alloca(argc * sizeof *iter_array)));
+    val buf = if2(over_limit, make_owned_buf(one, coerce(mem_t *, iter_array)));
     seq_build_t out = { 0 };
     args_decl(args_fun, max(argc, ARGS_MIN));
 
@@ -5798,8 +5809,11 @@ static val map_common(val self, val fun, varg lists,
         val elem;
         seq_iter_t *iter = &iter_array[i];
 
-        if (!seq_get(iter, &elem))
+        if (!seq_get(iter, &elem)) {
+          if (buf)
+            buf_free(buf);
           return collect_fn != 0 ? seq_finish(&out) : nil;
+        }
 
         args_fun->arg[i] = elem;
       }
diff --git a/tests/012/seq.tl b/tests/012/seq.tl
index 6ea572fe..21200268 100644
--- a/tests/012/seq.tl
+++ b/tests/012/seq.tl
@@ -822,3 +822,6 @@
 (test
   (zip "ab" '(#\i #\j) #("x" "y")) ("aix" "bjy"))
 
+(vtest
+  [apply mapcar join (list-seq "aaa".."zzz")]
+  (transpose (list-seq "aaa".."zzz")))
-- 
cgit v1.2.3