From a79fa7fc1637f90a10df6166e8f2ed9103353374 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 18 Apr 2018 06:55:31 -0700
Subject: apply: eliminate wasteful consing.

Now (pprof (apply '+ 1 2 3 4 5 '(6 7))) shows zero
bytes consed. Previously 176 (on 32 bit). This is
the same whether the expression is compiled or
interpreted.

* eval.c (applyv): Rewritten to efficiently manipulate the
args and call generic_funcall directly. The consing
funcction apply_intrinsic_frob_args is only used when
args contains a trailing list (args->list) and is only
used on that trailing list, not the entire arg list.
Also, changing the static function to external.

* eval.h (applyv): Declared.

* vm.c (vm_apply): Use applyv instead of wastefully
converting the arguments to a consed list and going through
apply_intrinsic.
---
 eval.c | 14 ++++++++++++--
 eval.h |  1 +
 vm.c   |  2 +-
 3 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/eval.c b/eval.c
index c98625a8..1ff89af2 100644
--- a/eval.c
+++ b/eval.c
@@ -1142,9 +1142,19 @@ val apply_intrinsic(val fun, val args)
   return apply(fun, apply_intrinsic_frob_args(z(args)));
 }
 
-static val applyv(val fun, struct args *args)
+val applyv(val fun, struct args *args)
 {
-  return apply_intrinsic(fun, args_get_list(args));
+  args_normalize_least(args, 1);
+
+  if (!args->fill)
+    uw_throwf(error_s, lit("apply: trailing-args argument missing"), nao);
+
+  if (!args->list)
+    args->list = z(args->arg[--args->fill]);
+  else
+    args->list = apply_intrinsic_frob_args(args->list);
+
+  return generic_funcall(fun, args);
 }
 
 static loc term(loc head)
diff --git a/eval.h b/eval.h
index fa0dc88a..4122d174 100644
--- a/eval.h
+++ b/eval.h
@@ -67,6 +67,7 @@ void reg_mac(val sym, val fun);
 val set_get_symacro(val sym, val form);
 val apply(val fun, val arglist);
 val apply_intrinsic(val fun, val args);
+val applyv(val fun, struct args *args);
 val eval_progn(val forms, val env, val ctx_form);
 val eval(val form, val env, val ctx_form);
 val eval_intrinsic(val form, val env);
diff --git a/vm.c b/vm.c
index 362f1adb..c0370343 100644
--- a/vm.c
+++ b/vm.c
@@ -464,7 +464,7 @@ static void vm_apply(struct vm *vm, vm_word_t insn)
     }
   }
 
-  result = apply_intrinsic(vm_get(vm->dspl, fun), args_get_list(args));
+  result = applyv(vm_get(vm->dspl, fun), args);
   vm_set(vm->dspl, dest, result);
 }
 
-- 
cgit v1.2.3