mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Small subr-call refactor

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2015-10-22 12:13:37 +00:00
parent 9144f50c31
commit 8832e8b68c
4 changed files with 58 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

7
doc/ref/vm.texi
View file

@ -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}

43
libguile/gsubr.c
View file

@ -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
@ -295,6 +295,47 @@ scm_i_primitive_call_ip (SCM subr)
return (scm_t_uintptr)(code + (code[3] ? 3 : code[2] ? 2 : 1));
}
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)())
{

6
libguile/gsubr.h
View file

@ -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,

74
libguile/vm-engine.c
View file

@ -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)))