mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 04:40:29 +02:00
inline frame replacement in tail-call
* libguile/programs.c (program_print): Only try to lookup write-program if the module system is booted. * libguile/vm-engine.h (FREE_FRAME): Remove, it's now inlined everywhere. * libguile/vm-i-system.c (tail-call): Inline FREE_FRAME, and implement the calling bits here. Will make things more hackable.
This commit is contained in:
parent
1dc8f8517c
commit
28106f547d
3 changed files with 48 additions and 35 deletions
|
@ -131,7 +131,7 @@ program_print (SCM program, SCM port, scm_print_state *pstate)
|
|||
{
|
||||
static int print_error = 0;
|
||||
|
||||
if (SCM_FALSEP (write_program))
|
||||
if (SCM_FALSEP (write_program) && scm_module_system_booted_p)
|
||||
write_program = scm_module_local_variable
|
||||
(scm_c_resolve_module ("system vm program"),
|
||||
scm_from_locale_symbol ("write-program"));
|
||||
|
|
|
@ -443,35 +443,6 @@ do { \
|
|||
data[0] = external; \
|
||||
}
|
||||
|
||||
#define FREE_FRAME() \
|
||||
{ \
|
||||
SCM *last_sp = sp; \
|
||||
SCM *last_fp = fp; \
|
||||
SCM *p = fp + bp->nargs + bp->nlocs; \
|
||||
\
|
||||
/* Restore pointers */ \
|
||||
ip = SCM_FRAME_BYTE_CAST (p[3]); \
|
||||
fp = SCM_FRAME_STACK_CAST (p[2]); \
|
||||
\
|
||||
if (!SCM_FALSEP (p[1])) \
|
||||
{ \
|
||||
/* Unlink the heap stack */ \
|
||||
vp->this_frame = p[1]; \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
/* Move stack items */ \
|
||||
p += 4; \
|
||||
sp = SCM_FRAME_LOWER_ADDRESS (last_fp); \
|
||||
while (p <= last_sp) \
|
||||
*sp++ = *p++; \
|
||||
sp--; \
|
||||
} \
|
||||
stack_base = fp ? \
|
||||
SCM_FRAME_UPPER_ADDRESS (fp) - 1 \
|
||||
: vp->stack_base; \
|
||||
}
|
||||
|
||||
#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
|
||||
|
||||
/*
|
||||
|
|
|
@ -442,7 +442,6 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
|
|||
if (SCM_PROGRAM_P (x))
|
||||
{
|
||||
program = x;
|
||||
vm_call_program:
|
||||
CACHE_PROGRAM ();
|
||||
INIT_ARGS ();
|
||||
NEW_FRAME ();
|
||||
|
@ -564,15 +563,58 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
|
|||
APPLY_HOOK ();
|
||||
NEXT;
|
||||
}
|
||||
|
||||
/*
|
||||
* Proper tail call
|
||||
* Tail call, but not to self -- reuse the frame, keeping the ra and dl
|
||||
*/
|
||||
if (SCM_PROGRAM_P (x))
|
||||
{
|
||||
SCM *data, *tail_args, *dl;
|
||||
int i;
|
||||
scm_byte_t *ra;
|
||||
|
||||
EXIT_HOOK ();
|
||||
FREE_FRAME ();
|
||||
program = x;
|
||||
goto vm_call_program;
|
||||
|
||||
/* save registers */
|
||||
tail_args = stack_base + 2;
|
||||
ra = SCM_FRAME_RETURN_ADDRESS (fp);
|
||||
dl = SCM_FRAME_DYNAMIC_LINK (fp);
|
||||
|
||||
/* switch programs */
|
||||
fp[-1] = program = x;
|
||||
CACHE_PROGRAM ();
|
||||
INIT_ARGS ();
|
||||
nargs = bp->nargs;
|
||||
|
||||
/* new registers -- logically this would be better later, but let's make
|
||||
sure we have space for the locals now */
|
||||
data = SCM_FRAME_DATA_ADDRESS (fp);
|
||||
ip = bp->base;
|
||||
stack_base = data + 3;
|
||||
sp = stack_base;
|
||||
CHECK_OVERFLOW ();
|
||||
|
||||
/* copy args, bottom-up */
|
||||
for (i = 0; i < nargs; i++)
|
||||
fp[i] = tail_args[i];
|
||||
|
||||
/* init locals */
|
||||
for (i = bp->nlocs; i; i--)
|
||||
data[-i] = SCM_UNDEFINED;
|
||||
|
||||
/* and the external variables */
|
||||
external = bp->external;
|
||||
for (i = 0; i < bp->nexts; i++)
|
||||
CONS (external, SCM_UNDEFINED, external);
|
||||
|
||||
/* Set frame data */
|
||||
data[3] = (SCM)ra;
|
||||
data[2] = (SCM)dl;
|
||||
data[1] = SCM_BOOL_F;
|
||||
data[0] = external;
|
||||
ENTER_HOOK ();
|
||||
APPLY_HOOK ();
|
||||
NEXT;
|
||||
}
|
||||
#ifdef ENABLE_TRAMPOLINE
|
||||
/* This seems to actually slow down the fibo test -- dunno why */
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue