diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2024-03-01 23:15:26 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2024-03-01 23:15:26 -0800 |
commit | 06bd10fd45dc008fe0ea4909254b2e951e715809 (patch) | |
tree | 596f442e02bf5f9cd1f4ca80248373902e4d552d | |
parent | 1134089866fde0478fe869aa6fa13e105325ddcd (diff) | |
download | txr-06bd10fd45dc008fe0ea4909254b2e951e715809.tar.gz txr-06bd10fd45dc008fe0ea4909254b2e951e715809.tar.bz2 txr-06bd10fd45dc008fe0ea4909254b2e951e715809.zip |
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.
-rw-r--r-- | buf.c | 13 | ||||
-rw-r--r-- | buf.h | 1 | ||||
-rw-r--r-- | eval.c | 18 | ||||
-rw-r--r-- | tests/012/seq.tl | 3 |
4 files changed, 33 insertions, 2 deletions
@@ -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"); @@ -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); @@ -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"))) |