[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-90-gc05805
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-90-gc05805a |
|
Date: |
Sun, 18 Mar 2012 19:22:07 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c05805a4ea764dec5a0559edefcdfb9761191d07
The branch, stable-2.0 has been updated
via c05805a4ea764dec5a0559edefcdfb9761191d07 (commit)
from 89d45e850725e232ae685803ee476da5b046c2b0 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c05805a4ea764dec5a0559edefcdfb9761191d07
Author: Andy Wingo <address@hidden>
Date: Sun Mar 18 20:04:28 2012 +0100
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.
-----------------------------------------------------------------------
Summary of changes:
libguile/procprop.c | 12 ++-
libguile/smob.c | 329 ++++++++++-------------------------------------
libguile/smob.h | 3 +-
libguile/vm-i-system.c | 14 +-
libguile/vm.c | 19 +++
5 files changed, 107 insertions(+), 270 deletions(-)
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 9a75254..36228d3 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -80,8 +80,16 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int
*rest)
case scm_tc7_smob:
if (!SCM_SMOB_APPLICABLE_P (proc))
return 0;
- proc = scm_i_smob_apply_trampoline (proc);
- break;
+ if (!scm_i_program_arity
+ (SCM_SMOB_DESCRIPTOR (proc).apply_trampoline_objcode,
+ req, opt, rest))
+ return 0;
+
+ /* The trampoline gets the smob too, which users don't
+ see. */
+ *req -= 1;
+
+ return 1;
case scm_tcs_struct:
if (!SCM_STRUCT_APPLICABLE_P (proc))
return 0;
diff --git a/libguile/smob.c b/libguile/smob.c
index 6a341ef..1911460 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -120,233 +120,81 @@ scm_smob_print (SCM exp, SCM port, scm_print_state
*pstate SCM_UNUSED)
/* {Apply}
*/
-#ifdef WORDS_BIGENDIAN
-#define OBJCODE_HEADER 0, 0, 0, 16, 0, 0, 0, 40
-#define META_HEADER 0, 0, 0, 32, 0, 0, 0, 0
-#else
-#define OBJCODE_HEADER 16, 0, 0, 0, 40, 0, 0, 0
-#define META_HEADER 32, 0, 0, 0, 0, 0, 0, 0
-#endif
-
-/* This code is the same as in gsubr.c, except we use smob_call instead of
- struct_call. */
-
-/* A: req; B: opt; C: rest */
-#define A(nreq) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_assert_nargs_ee, 0, nreq, /* assert number of args */ \
- /* 3 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr
pointer */ \
- /* 5 */ scm_op_smob_call, nreq, /* and call (will return value as well) */ \
- /* 7 */ scm_op_nop, \
- /* 8 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (3, 7, nreq, 0, 0)
-
-#define B(nopt) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_bind_optionals, 0, nopt, /* bind optionals */ \
- /* 3 */ scm_op_assert_nargs_ee, 0, nopt, /* assert number of args */ \
- /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the smob
pointer */ \
- /* 8 */ scm_op_smob_call, nopt, /* and call (will return value as well) */ \
- /* 10 */ scm_op_nop, scm_op_nop, \
- /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (6, 10, 0, nopt, 0)
-
-#define C() \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_push_rest, 0, 0, /* cons all args into a list */ \
- /* 3 */ scm_op_object_ref, 0, /* push the foreign object wrapping the smob
pointer */ \
- /* 5 */ scm_op_smob_call, 1, /* and call (will return value as well) */ \
- /* 7 */ scm_op_nop, \
- /* 8 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (3, 7, 0, 0, 1)
-
-#define AB(nreq, nopt) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \
- /* 3 */ scm_op_bind_optionals, 0, nreq+nopt, /* bind optionals */ \
- /* 6 */ scm_op_assert_nargs_ee, 0, nreq+nopt, /* assert number of args */ \
- /* 9 */ scm_op_object_ref, 0, /* push the foreign object wrapping the smob
pointer */ \
- /* 11 */ scm_op_smob_call, nreq+nopt, /* and call (will return value as
well) */ \
- /* 13 */ scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (9, 13, nreq, nopt, 0)
-
-#define AC(nreq) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \
- /* 3 */ scm_op_push_rest, 0, nreq, /* cons rest list */ \
- /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the smob
pointer */ \
- /* 8 */ scm_op_smob_call, nreq+1, /* and call (will return value as well) */
\
- /* 10 */ scm_op_nop, scm_op_nop, \
- /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (6, 10, nreq, 0, 1)
-
-#define BC(nopt) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_bind_optionals, 0, nopt, /* bind optionals */ \
- /* 3 */ scm_op_push_rest, 0, nopt, /* cons rest list */ \
- /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the smob
pointer */ \
- /* 8 */ scm_op_smob_call, nopt+1, /* and call (will return value as well) */
\
- /* 10 */ scm_op_nop, scm_op_nop, \
- /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (6, 10, 0, nopt, 1)
-
-#define ABC(nreq, nopt) \
- OBJCODE_HEADER, \
- /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \
- /* 3 */ scm_op_bind_optionals, 0, nreq+nopt, /* bind optionals */ \
- /* 6 */ scm_op_push_rest, 0, nreq+nopt, /* cons rest list */ \
- /* 9 */ scm_op_object_ref, 0, /* push the foreign object wrapping the smob
pointer */ \
- /* 11 */ scm_op_smob_call, nreq+nopt+1, /* and call (will return value as
well) */ \
- /* 13 */ scm_op_nop, scm_op_nop, scm_op_nop, \
- /* 16 */ META (9, 13, nreq, nopt, 1)
+static SCM scm_smob_trampolines[16];
-#define META(start, end, nreq, nopt, rest) \
- META_HEADER, \
- /* 0 */ scm_op_make_eol, /* bindings */ \
- /* 1 */ scm_op_make_eol, /* sources */ \
- /* 2 */ scm_op_make_int8, start, scm_op_make_int8, end, /* arity: from ip N
to ip N */ \
- /* 6 */ scm_op_make_int8, nreq, /* the arity is N required args */ \
- /* 8 */ scm_op_make_int8, nopt, /* N optionals */ \
- /* 10 */ rest ? scm_op_make_true : scm_op_make_false, /* maybe a rest arg */
\
- /* 11 */ scm_op_list, 0, 5, /* make a list of those 5 vals */ \
- /* 14 */ scm_op_list, 0, 1, /* and the arities will be a list of that one
list */ \
- /* 17 */ scm_op_load_symbol, 0, 0, 4, 'n', 'a', 'm', 'e', /* `name' */ \
- /* 25 */ scm_op_object_ref, 1, /* the name from the object table */ \
- /* 27 */ scm_op_cons, /* make a pair for the properties */ \
- /* 28 */ scm_op_list, 0, 4, /* pack bindings, sources, and arities into list
*/ \
- /* 31 */ scm_op_return /* and return */ \
- /* 32 */
-
-static const struct
+/* (nargs * nargs) + nopt + rest * (nargs + 1) */
+#define SCM_SMOB_TRAMPOLINE(nreq,nopt,rest) \
+ scm_smob_trampolines[(nreq + nopt + rest) * (nreq + nopt + rest) \
+ + nopt + rest * (nreq + nopt + rest + 1)]
+
+static SCM
+apply_0 (SCM smob)
{
- scm_t_uint64 dummy; /* ensure 8-byte alignment; perhaps there's a better way
*/
- const scm_t_uint8 bytes[16 * (sizeof (struct scm_objcode) + 16
- + sizeof (struct scm_objcode) + 32)];
-} raw_bytecode = {
- 0,
- {
- /* Use the elisp macros from gsubr.c */
- /* C-u 3 M-x generate-bytecodes RET */
- /* 0 arguments */
- A(0),
- /* 1 arguments */
- A(1), B(1), C(),
- /* 2 arguments */
- A(2), AB(1,1), B(2), AC(1), BC(1),
- /* 3 arguments */
- A(3), AB(2,1), AB(1,2), B(3), AC(2), ABC(1,1), BC(2)
- }
-};
-
-#undef A
-#undef B
-#undef C
-#undef AB
-#undef AC
-#undef BC
-#undef ABC
-#undef OBJCODE_HEADER
-#undef META_HEADER
-#undef META
-
-#define STATIC_OBJCODE_TAG \
- SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
-
-static const struct
+ SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ return subr (smob);
+}
+
+static SCM
+apply_1 (SCM smob, SCM a)
{
- scm_t_uint64 dummy; /* alignment */
- scm_t_cell cells[16 * 2]; /* 4*4 double cells */
-} objcode_cells = {
- 0,
- /* C-u 3 M-x generate-objcode-cells RET */
- {
- /* 0 arguments */
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 0) },
- { SCM_BOOL_F, SCM_PACK (0) },
-
- /* 1 arguments */
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 64) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 128) },
- { SCM_BOOL_F, SCM_PACK (0) },
-
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 192) },
- { SCM_BOOL_F, SCM_PACK (0) },
-
- /* 2 arguments */
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 256) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 320) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 384) },
- { SCM_BOOL_F, SCM_PACK (0) },
-
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 448) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 512) },
- { SCM_BOOL_F, SCM_PACK (0) },
-
- /* 3 arguments */
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 576) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 640) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 704) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 768) },
- { SCM_BOOL_F, SCM_PACK (0) },
-
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 832) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 896) },
- { SCM_BOOL_F, SCM_PACK (0) },
- { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 960) },
- { SCM_BOOL_F, SCM_PACK (0) }
- }
-};
-
-static const SCM scm_smob_objcode_trampolines[16] = {
- /* C-u 3 M-x generate-objcodes RET */
- /* 0 arguments */
- SCM_PACK (objcode_cells.cells+0),
-
- /* 1 arguments */
- SCM_PACK (objcode_cells.cells+2),
- SCM_PACK (objcode_cells.cells+4),
- SCM_PACK (objcode_cells.cells+6),
-
- /* 2 arguments */
- SCM_PACK (objcode_cells.cells+8),
- SCM_PACK (objcode_cells.cells+10),
- SCM_PACK (objcode_cells.cells+12),
- SCM_PACK (objcode_cells.cells+14),
- SCM_PACK (objcode_cells.cells+16),
-
- /* 3 arguments */
- SCM_PACK (objcode_cells.cells+18),
- SCM_PACK (objcode_cells.cells+20),
- SCM_PACK (objcode_cells.cells+22),
- SCM_PACK (objcode_cells.cells+24),
- SCM_PACK (objcode_cells.cells+26),
- SCM_PACK (objcode_cells.cells+28),
- SCM_PACK (objcode_cells.cells+30)
-};
+ SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ return subr (smob, a);
+}
-/* (nargs * nargs) + nopt + rest * (nargs + 1) */
-#define SCM_SMOB_OBJCODE_TRAMPOLINE(nreq,nopt,rest) \
- scm_smob_objcode_trampolines[(nreq + nopt + rest) * (nreq + nopt + rest) \
- + nopt + rest * (nreq + nopt + rest + 1)]
+static SCM
+apply_2 (SCM smob, SCM a, SCM b)
+{
+ SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ return subr (smob, a, b);
+}
static SCM
-scm_smob_objcode_trampoline (unsigned int nreq, unsigned int nopt,
- unsigned int rest)
+apply_3 (SCM smob, SCM a, SCM b, SCM c)
{
+ SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ return subr (smob, a, b, c);
+}
+
+static SCM
+scm_smob_trampoline (unsigned int nreq, unsigned int nopt,
+ unsigned int rest)
+{
+ SCM trampoline;
+
if (SCM_UNLIKELY (rest > 1 || nreq + nopt + rest > 3))
scm_out_of_range ("make-smob", scm_from_uint (nreq + nopt + rest));
- return SCM_SMOB_OBJCODE_TRAMPOLINE (nreq, nopt, rest);
+ trampoline = SCM_SMOB_TRAMPOLINE (nreq, nopt, rest);
+
+ if (SCM_LIKELY (SCM_UNPACK (trampoline)))
+ return trampoline;
+
+ switch (nreq + nopt + rest)
+ {
+ /* The + 1 is for the smob itself. */
+ case 0:
+ trampoline = scm_c_make_gsubr ("apply-smob/0", nreq + 1, nopt, rest,
+ apply_0);
+ break;
+ case 1:
+ trampoline = scm_c_make_gsubr ("apply-smob/1", nreq + 1, nopt, rest,
+ apply_1);
+ break;
+ case 2:
+ trampoline = scm_c_make_gsubr ("apply-smob/2", nreq + 1, nopt, rest,
+ apply_2);
+ break;
+ case 3:
+ trampoline = scm_c_make_gsubr ("apply-smob/3", nreq + 1, nopt, rest,
+ apply_3);
+ break;
+ default:
+ abort ();
+ }
+
+ SCM_SMOB_TRAMPOLINE (nreq, nopt, rest) = trampoline;
+
+ return trampoline;
}
@@ -406,51 +254,16 @@ void
scm_set_smob_apply (scm_t_bits tc, SCM (*apply) (),
unsigned int req, unsigned int opt, unsigned int rst)
{
- scm_smobs[SCM_TC2SMOBNUM (tc)].apply = apply;
- scm_smobs[SCM_TC2SMOBNUM (tc)].apply_trampoline_objcode
- = scm_smob_objcode_trampoline (req, opt, rst);
+ SCM trampoline = scm_smob_trampoline (req, opt, rst);
+
+ scm_smobs[SCM_TC2SMOBNUM (tc)].apply = apply;
+ /* In 2.2 this field is renamed to "apply_trampoline". */
+ scm_smobs[SCM_TC2SMOBNUM (tc)].apply_trampoline_objcode = trampoline;
if (SCM_UNPACK (scm_smob_class[0]) != 0)
scm_i_inherit_applicable (scm_smob_class[SCM_TC2SMOBNUM (tc)]);
}
-static SCM tramp_weak_map = SCM_BOOL_F;
-static scm_i_pthread_mutex_t tramp_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-SCM
-scm_i_smob_apply_trampoline (SCM smob)
-{
- SCM tramp;
-
- scm_i_pthread_mutex_lock (&tramp_lock);
- tramp = scm_hashq_ref (tramp_weak_map, smob, SCM_BOOL_F);
- scm_i_pthread_mutex_unlock (&tramp_lock);
-
- if (scm_is_true (tramp))
- return tramp;
- else
- {
- const char *name;
- SCM objtable;
-
- name = SCM_SMOBNAME (SCM_SMOBNUM (smob));
- if (!name)
- name = "smob-apply";
- objtable = scm_c_make_vector (2, SCM_UNDEFINED);
- SCM_SIMPLE_VECTOR_SET (objtable, 0, smob);
- SCM_SIMPLE_VECTOR_SET (objtable, 1, scm_from_locale_symbol (name));
- tramp = scm_make_program (SCM_SMOB_DESCRIPTOR
(smob).apply_trampoline_objcode,
- objtable, SCM_BOOL_F);
-
- /* Race conditions (between the ref and this set!) cannot cause
- any harm here. */
- scm_i_pthread_mutex_lock (&tramp_lock);
- scm_hashq_set_x (tramp_weak_map, smob, tramp);
- scm_i_pthread_mutex_unlock (&tramp_lock);
- return tramp;
- }
-}
-
SCM
scm_make_smob (scm_t_bits tc)
{
@@ -679,8 +492,6 @@ scm_smob_prehistory ()
scm_smobs[i].apply = 0;
scm_smobs[i].apply_trampoline_objcode = SCM_BOOL_F;
}
-
- tramp_weak_map = scm_make_weak_key_hash_table (SCM_UNDEFINED);
}
/*
diff --git a/libguile/smob.h b/libguile/smob.h
index cfe12c3..d4b7c6c 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -40,6 +40,7 @@ typedef struct scm_smob_descriptor
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM);
scm_t_subr apply;
+ /* In 2.2 this field is renamed to "apply_trampoline". */
SCM apply_trampoline_objcode;
} scm_smob_descriptor;
@@ -204,8 +205,6 @@ SCM_API void scm_assert_smob_type (scm_t_bits tag, SCM val);
SCM_API SCM scm_make_smob (scm_t_bits tc);
-SCM_INTERNAL SCM scm_i_smob_apply_trampoline (SCM smob);
-
SCM_API void scm_smob_prehistory (void);
#endif /* SCM_SMOB_H */
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 474fe78..21fa5a1 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -790,8 +790,8 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
else if (SCM_NIMP (program) && SCM_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
@@ -838,8 +838,8 @@ VM_DEFINE_INSTRUCTION (54, tail_call, "tail-call", 1, -1, 1)
else if (SCM_NIMP (program) && SCM_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
@@ -1099,8 +1099,8 @@ VM_DEFINE_INSTRUCTION (62, mv_call, "mv-call", 4, -1, 1)
else if (SCM_NIMP (program) && SCM_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
diff --git a/libguile/vm.c b/libguile/vm.c
index 8fae656..d1c7bbc 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -423,6 +423,25 @@ vm_make_boot_program (long nargs)
* VM
*/
+/* We are calling a SMOB. The calling code pushed the SMOB after the
+ args, and incremented nargs. That nargs is passed here. This
+ function's job is to replace the procedure with the trampoline, and
+ shuffle the smob itself to be argument 0. This function must not
+ allocate or throw, as the VM registers are not synchronized. */
+static void
+prepare_smob_call (SCM *sp, int nargs, SCM smob)
+{
+ SCM *args = sp - nargs + 1;
+
+ /* Shuffle args up. */
+ while (nargs--)
+ args[nargs + 1] = args[nargs];
+
+ args[0] = smob;
+ /* apply_trampoline_objcode is actually a program. */
+ args[-1] = SCM_SMOB_DESCRIPTOR (smob).apply_trampoline_objcode;
+}
+
static SCM
resolve_variable (SCM what, SCM program_module)
{
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-90-gc05805a,
Andy Wingo <=