mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

first step to make the vm stop calling the interpreter

Browse source 
* libguile/eval.h:
* libguile/eval.c (scm_closure_apply): New function, applies a closure.
  Won't be necessary in the future, but for now here it is, with
  internal linkage.

* libguile/gsubr.h:
* libguile/gsubr.c (scm_i_gsubr_apply_array): New function, applies a
  gsubr to an array of values, potentially extending that array for
  optional arguments and rest arguments and such.

* libguile/vm.c (apply_foreign): New function, applies a foreign
  function to arguments on the stack, in place.

* libguile/vm-i-system.c (call): Add a case for procedures-with-setters
  (will go away when they are applicable structs). Instead of calling
  the evaluator for foreign functions, call apply_foreign.
This commit is contained in:
Andy Wingo 2009-12-01 21:59:42 +01:00
parent 5161a3c0d7
commit 23f276dea7
6 changed files with 224 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

39
libguile/gsubr.c
View file

@ -317,6 +317,45 @@ scm_i_gsubr_apply_list (SCM self, SCM args)
}
#undef FUNC_NAME
/* Apply SELF, a gsubr, to the arguments in ARGS. Missing optional
arguments are added, and rest arguments are consed into a list. */
SCM
scm_i_gsubr_apply_array (SCM self, SCM *args, int nargs, int headroom)
#define FUNC_NAME "scm_i_gsubr_apply"
{
unsigned int typ = SCM_GSUBR_TYPE (self);
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
if (SCM_UNLIKELY (nargs < SCM_GSUBR_REQ (typ)))
scm_wrong_num_args (SCM_SUBR_NAME (self));
if (SCM_UNLIKELY (headroom < n - nargs))
{
/* fallback on apply-list */
SCM arglist = SCM_EOL;
while (nargs--)
arglist = scm_cons (args[nargs], arglist);
return scm_i_gsubr_apply_list (self, arglist);
}
for (i = nargs; i < SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ); i++)
args[i] = SCM_UNDEFINED;
if (SCM_GSUBR_REST(typ))
{
SCM rest = SCM_EOL;
/* fallback on apply-list */
while (nargs-- >= n)
rest = scm_cons (args[nargs], rest);
args[n - 1] = rest;
}
else if (nargs > n)
scm_wrong_num_args (SCM_SUBR_NAME (self));
return gsubr_apply_raw (self, n, args);
}
#undef FUNC_NAME
#ifdef GSUBR_TEST
/* A silly example, taking 2 required args, 1 optional, and