mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Andy Wingo
parent
9144f50c31
commit
8832e8b68c
4 changed files with 58 additions and 72 deletions
|
|
@ -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
|
it's still interesting to know how these things work, so we document
|
||||||
these trampoline instructions here.
|
these trampoline instructions here.
|
||||||
|
|
||||||
@deftypefn Instruction {} subr-call c24:@var{ptr-idx}
|
@deftypefn Instruction {} subr-call x24:@var{_}
|
||||||
Call a subr, passing all locals in this frame as arguments. Fetch the
|
Call a subr, passing all locals in this frame as arguments. Return from
|
||||||
foreign pointer from @var{ptr-idx}, a free variable. Return from the
|
the calling frame.
|
||||||
calling frame.
|
|
||||||
@end deftypefn
|
@end deftypefn
|
||||||
|
|
||||||
@deftypefn Instruction {} foreign-call c12:@var{cif-idx} c12:@var{ptr-idx}
|
@deftypefn Instruction {} foreign-call c12:@var{cif-idx} c12:@var{ptr-idx}
|
||||||
|
|
|
||||||
|
|
@ -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.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* 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));
|
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
|
||||||
scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
|
scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
|
||||||
{
|
{
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@
|
||||||
#define SCM_GSUBR_H
|
#define SCM_GSUBR_H
|
||||||
|
|
||||||
/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2006, 2008, 2009,
|
/* 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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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 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);
|
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,
|
SCM_API SCM scm_c_make_gsubr (const char *name,
|
||||||
int req, int opt, int rst, scm_t_subr fcn);
|
int req, int opt, int rst, scm_t_subr fcn);
|
||||||
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
|
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
|
||||||
|
|
|
||||||
|
|
@ -781,77 +781,19 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
||||||
* Specialized call stubs
|
* Specialized call stubs
|
||||||
*/
|
*/
|
||||||
|
|
||||||
/* subr-call ptr-idx:24
|
/* subr-call _:24
|
||||||
*
|
*
|
||||||
* Call a subr, passing all locals in this frame as arguments. Fetch
|
* Call a subr, passing all locals in this frame as arguments. Return
|
||||||
* the foreign pointer from PTR-IDX, a free variable. Return from the
|
* from the calling frame. This instruction is part of the
|
||||||
* calling frame. This instruction is part of the trampolines
|
* trampolines created in gsubr.c, and is not generated by the
|
||||||
* created in gsubr.c, and is not generated by the compiler.
|
* 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 ret;
|
||||||
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);
|
|
||||||
|
|
||||||
SYNC_IP ();
|
SYNC_IP ();
|
||||||
|
ret = scm_apply_subr (sp, FRAME_LOCALS_COUNT ());
|
||||||
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 ();
|
|
||||||
}
|
|
||||||
|
|
||||||
CACHE_SP ();
|
CACHE_SP ();
|
||||||
|
|
||||||
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
|
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue