diff options
author | Andy Wingo <wingo@pobox.com> | 2012-03-18 20:04:28 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-03-18 20:06:06 +0100 |
commit | 80be163f81e0dcc16e6805d4c2d1f2de3ca38c55 (patch) | |
tree | 4826f61678e7792d73bc957a7f3af29aacae67a2 /libguile/vm-i-system.c | |
parent | d5e1f8224068c3c579b9a6d77450d50af512aa52 (diff) | |
download | guile-80be163f81e0dcc16e6805d4c2d1f2de3ca38c55.tar.gz |
make applicable smob calls cheaper, and fix a memory leak
* libguile/vm.c (prepare_smob_call): New helper. Now, instead of making
a per-smob trampoline, we will shuffle the smob into the args and use
a gsubr. This prevents a memory leak in which the trampolines, which
were values in a weak-key table, were preventing the smobs from being
collected.
* libguile/vm-i-system.c (call, tail-call, mv-call): Adapt to new smob
application mechanism.
(smob-call): Remove this instruction.
* libguile/smob.h (scm_smob_descriptor): Rename apply_trampoline_objcode
to apply_trampoline.
* libguile/smob.c: Remove our own objcode trampolines in favor of using
scm_c_make_gsubr.
(scm_smob_prehistory): No more trampoline weak map.
* libguile/procprop.c (scm_i_procedure_arity): Adapt to applicable smob
representation change.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r-- | libguile/vm-i-system.c | 59 |
1 files changed, 7 insertions, 52 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index bad4c3020..7153ab589 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -803,8 +803,8 @@ VM_DEFINE_INSTRUCTION (55, call, "call", 1, -1, 1) else if (SCM_HAS_TYP7 (program, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (program)) { - SYNC_REGISTER (); - sp[-nargs] = scm_i_smob_apply_trampoline (program); + PUSH (program); + prepare_smob_call (sp, ++nargs, program); goto vm_call; } else @@ -851,8 +851,8 @@ VM_DEFINE_INSTRUCTION (56, tail_call, "tail-call", 1, -1, 1) else if (SCM_HAS_TYP7 (program, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (program)) { - SYNC_REGISTER (); - sp[-nargs] = scm_i_smob_apply_trampoline (program); + PUSH (program); + prepare_smob_call (sp, ++nargs, program); goto vm_tail_call; } else @@ -952,52 +952,7 @@ VM_DEFINE_INSTRUCTION (57, subr_call, "subr-call", 1, -1, -1) } } -VM_DEFINE_INSTRUCTION (58, smob_call, "smob-call", 1, -1, -1) -{ - SCM smob, ret; - SCM (*subr)(); - nargs = FETCH (); - POP (smob); - - subr = SCM_SMOB_DESCRIPTOR (smob).apply; - - VM_HANDLE_INTERRUPTS; - SYNC_REGISTER (); - - switch (nargs) - { - case 0: - ret = subr (smob); - break; - case 1: - ret = subr (smob, sp[0]); - break; - case 2: - ret = subr (smob, sp[-1], sp[0]); - break; - case 3: - ret = subr (smob, sp[-2], sp[-1], sp[0]); - break; - default: - abort (); - } - - NULLSTACK_FOR_NONLOCAL_EXIT (); - - if (SCM_UNLIKELY (SCM_VALUESP (ret))) - { - /* multiple values returned to continuation */ - ret = scm_struct_ref (ret, SCM_INUM0); - nvalues = scm_ilength (ret); - PUSH_LIST (ret, scm_is_null); - goto vm_return_values; - } - else - { - PUSH (ret); - goto vm_return; - } -} +/* Instruction 58 used to be smob-call. */ VM_DEFINE_INSTRUCTION (59, foreign_call, "foreign-call", 1, -1, -1) { @@ -1104,8 +1059,8 @@ VM_DEFINE_INSTRUCTION (64, mv_call, "mv-call", 4, -1, 1) else if (SCM_HAS_TYP7 (program, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (program)) { - SYNC_REGISTER (); - sp[-nargs] = scm_i_smob_apply_trampoline (program); + PUSH (program); + prepare_smob_call (sp, ++nargs, program); goto vm_mv_call; } else |