1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 15:40:19 +02:00

smobs are applied with vm trampoline procedures

* libguile/smob.c: Instead of having special evaluator support for
  applying smobs, we use the same strategy that gsubr uses, that smob
  application should happen via a trampoline VM procedure, which uses a
  special opcode (smob-apply). So statically allocate all of the desired
  trampoline procedures here.
  (scm_i_smob_apply_trampoline): Unfortunately there's no real place to
  put the trampoline, so instead use a weak-key hash. It's nasty, but I
  think the benefits of speeding up procedure calls in the general case
  are worth it.

* libguile/smob.h (scm_smob_descriptor): Remove fields apply_0, apply_1,
  apply_2, and apply_3; these were never public. Also remove the
  gsubr_type field. Instead cache the trampoline objcode here.
  (SCM_SMOB_APPLY_0, SCM_SMOB_APPLY_1, SCM_SMOB_APPLY_2,
  SCM_SMOB_APPLY_3): Just go through scm_call_0, etc here.

* libguile/vm-i-system.c (call, tail-call, mv-call): Simplify. All
  procedure calls are VM calls now.
  (smob-call): New instruction, used in smob trampoline procedures.

* libguile/vm.c (apply_foreign): Remove. Yay!

* libguile/procprop.c (scm_i_procedure_arity): Refactor a bit for the
  smob changes.
This commit is contained in:
Andy Wingo 2010-01-09 14:12:47 +01:00
parent 9174596d5b
commit 75c3ed2820
5 changed files with 399 additions and 479 deletions

View file

@ -273,39 +273,6 @@ resolve_variable (SCM what, SCM program_module)
}
}
static SCM
apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
{
SCM_ASRTGO (SCM_NIMP (proc), badproc);
switch (SCM_TYP7 (proc))
{
case scm_tc7_smob:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badproc;
switch (nargs)
{
case 0:
return SCM_SMOB_APPLY_0 (proc);
case 1:
return SCM_SMOB_APPLY_1 (proc, args[0]);
case 2:
return SCM_SMOB_APPLY_2 (proc, args[0], args[1]);
default:
{
SCM arglist = SCM_EOL;
while (nargs-- > 2)
arglist = scm_cons (args[nargs], arglist);
return SCM_SMOB_APPLY_3 (proc, args[0], args[1], arglist);
}
}
default:
badproc:
scm_wrong_type_arg ("apply", SCM_ARG1, proc);
}
}
#define VM_DEFAULT_STACK_SIZE (64 * 1024)
#define VM_NAME vm_regular_engine