1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00

RTL engine can apply smobs and applicable structs w/o stack VM

* libguile/vm-engine.c (rtl_vm_engine): Allow the RTL VM to handle the
  dispatch for SMOBs and applicable structs.
This commit is contained in:
Andy Wingo 2013-10-17 23:24:16 +02:00
parent 8d23c43641
commit 9d87158fdb

View file

@ -898,7 +898,6 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
apply:
while (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
{
#if 0
SCM proc = SCM_FRAME_PROGRAM (fp);
if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
@ -910,19 +909,20 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
{
scm_t_uint32 n = FRAME_LOCALS_COUNT();
/* Shuffle args up, place smob in local 0. */
CHECK_OVERFLOW (vp->sp + 1);
vp->sp++;
/* Shuffle args up. */
RESET_FRAME (n + 1);
while (n--)
LOCAL_SET (n + 1, LOCAL_REF (n));
fp[-1] = SCM_SMOB_DESCRIPTOR (proc).apply_trampoline;
LOCAL_SET (0, SCM_SMOB_DESCRIPTOR (proc).apply_trampoline);
continue;
}
#if 0
SYNC_IP();
vm_error_wrong_type_apply (proc);
#else
{
SCM ret;
SYNC_ALL ();
@ -932,6 +932,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
else
RETURN_ONE_VALUE (ret);
}
#endif
}