summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-10-22 12:13:37 +0000
committerAndy Wingo <wingo@pobox.com>2015-10-22 12:13:37 +0000
commit8832e8b68c528fe48e65902692abe713730dd68e (patch)
treed532004275af2d84d1b17360d28d3067049c6a1a
parent9144f50c319845828515ceb313609da9e827ffa6 (diff)
downloadguile-8832e8b68c528fe48e65902692abe713730dd68e.tar.gz
Small subr-call refactor
* libguile/gsubr.c (scm_apply_subr): New internal helper. * libguile/vm-engine.c (subr-call): Call out to scm_apply_subr. * doc/ref/vm.texi (subr-call): Don't specify how the foreign pointer is obtained.
-rw-r--r--doc/ref/vm.texi7
-rw-r--r--libguile/gsubr.c43
-rw-r--r--libguile/gsubr.h6
-rw-r--r--libguile/vm-engine.c74
4 files changed, 58 insertions, 72 deletions
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 45c3928a0..e44f21169 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -888,10 +888,9 @@ compiler probably shouldn't emit code with these instructions. However,
it's still interesting to know how these things work, so we document
these trampoline instructions here.
-@deftypefn Instruction {} subr-call c24:@var{ptr-idx}
-Call a subr, passing all locals in this frame as arguments. Fetch the
-foreign pointer from @var{ptr-idx}, a free variable. Return from the
-calling frame.
+@deftypefn Instruction {} subr-call x24:@var{_}
+Call a subr, passing all locals in this frame as arguments. Return from
+the calling frame.
@end deftypefn
@deftypefn Instruction {} foreign-call c12:@var{cif-idx} c12:@var{ptr-idx}
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 329241da2..a3b804bb5 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013
+/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013, 2015
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -296,6 +296,47 @@ scm_i_primitive_call_ip (SCM subr)
}
SCM
+scm_apply_subr (union scm_vm_stack_element *sp, scm_t_ptrdiff nslots)
+{
+ SCM (*subr)() = SCM_SUBRF (sp[nslots - 1].as_scm);
+
+#define ARG(i) (sp[i].as_scm)
+ switch (nslots - 1)
+ {
+ case 0:
+ return subr ();
+ case 1:
+ return subr (ARG (0));
+ case 2:
+ return subr (ARG (1), ARG (0));
+ case 3:
+ return subr (ARG (2), ARG (1), ARG (0));
+ case 4:
+ return subr (ARG (3), ARG (2), ARG (1), ARG (0));
+ case 5:
+ return subr (ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+ case 6:
+ return subr (ARG (5), ARG (4), ARG (3), ARG (2), ARG (1),
+ ARG (0));
+ case 7:
+ return subr (ARG (6), ARG (5), ARG (4), ARG (3), ARG (2),
+ ARG (1), ARG (0));
+ case 8:
+ return subr (ARG (7), ARG (6), ARG (5), ARG (4), ARG (3),
+ ARG (2), ARG (1), ARG (0));
+ case 9:
+ return subr (ARG (8), ARG (7), ARG (6), ARG (5), ARG (4),
+ ARG (3), ARG (2), ARG (1), ARG (0));
+ case 10:
+ return subr (ARG (9), ARG (8), ARG (7), ARG (6), ARG (5),
+ ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+ default:
+ abort ();
+ }
+#undef ARG
+}
+
+SCM
scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
{
return create_subr (0, name, req, opt, rst, fcn, NULL);
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 065b94766..a9db85e44 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -4,7 +4,7 @@
#define SCM_GSUBR_H
/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2006, 2008, 2009,
- * 2010, 2011, 2013 Free Software Foundation, Inc.
+ * 2010, 2011, 2013, 2015 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -57,6 +57,10 @@
SCM_INTERNAL int scm_i_primitive_arity (SCM subr, int *req, int *opt, int *rest);
SCM_INTERNAL scm_t_uintptr scm_i_primitive_call_ip (SCM subr);
+union scm_vm_stack_element;
+SCM_INTERNAL SCM scm_apply_subr (union scm_vm_stack_element *sp,
+ scm_t_ptrdiff nargs);
+
SCM_API SCM scm_c_make_gsubr (const char *name,
int req, int opt, int rst, scm_t_subr fcn);
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 308c04cd9..d5f68578d 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -781,77 +781,19 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
* Specialized call stubs
*/
- /* subr-call ptr-idx:24
+ /* subr-call _:24
*
- * Call a subr, passing all locals in this frame as arguments. Fetch
- * the foreign pointer from PTR-IDX, a free variable. Return from the
- * calling frame. This instruction is part of the trampolines
- * created in gsubr.c, and is not generated by the compiler.
+ * Call a subr, passing all locals in this frame as arguments. Return
+ * from the calling frame. This instruction is part of the
+ * trampolines created in gsubr.c, and is not generated by the
+ * compiler.
*/
- VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X8_C24))
+ VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X32))
{
- scm_t_uint32 ptr_idx;
- SCM pointer, ret;
- SCM (*subr)();
-
- UNPACK_24 (op, ptr_idx);
-
- pointer = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), ptr_idx);
- subr = SCM_POINTER_VALUE (pointer);
+ SCM ret;
SYNC_IP ();
-
- switch (FRAME_LOCALS_COUNT_FROM (1))
- {
- case 0:
- ret = subr ();
- break;
- case 1:
- ret = subr (SP_REF (0));
- break;
- case 2:
- ret = subr (SP_REF (1), SP_REF (0));
- break;
- case 3:
- ret = subr (SP_REF (2), SP_REF (1), SP_REF (0));
- break;
- case 4:
- ret = subr (SP_REF (3), SP_REF (2), SP_REF (1),
- SP_REF (0));
- break;
- case 5:
- ret = subr (SP_REF (4), SP_REF (3), SP_REF (2),
- SP_REF (1), SP_REF (0));
- break;
- case 6:
- ret = subr (SP_REF (5), SP_REF (4), SP_REF (3),
- SP_REF (2), SP_REF (1), SP_REF (0));
- break;
- case 7:
- ret = subr (SP_REF (6), SP_REF (5), SP_REF (4),
- SP_REF (3), SP_REF (2), SP_REF (1),
- SP_REF (0));
- break;
- case 8:
- ret = subr (SP_REF (7), SP_REF (6), SP_REF (5),
- SP_REF (4), SP_REF (3), SP_REF (2),
- SP_REF (1), SP_REF (0));
- break;
- case 9:
- ret = subr (SP_REF (8), SP_REF (7), SP_REF (6),
- SP_REF (5), SP_REF (4), SP_REF (3),
- SP_REF (2), SP_REF (1), SP_REF (0));
- break;
- case 10:
- ret = subr (SP_REF (9), SP_REF (8), SP_REF (7),
- SP_REF (6), SP_REF (5), SP_REF (4),
- SP_REF (3), SP_REF (2), SP_REF (1),
- SP_REF (0));
- break;
- default:
- abort ();
- }
-
+ ret = scm_apply_subr (sp, FRAME_LOCALS_COUNT ());
CACHE_SP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret)))