summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/programs.c2
-rw-r--r--libguile/vm-engine.h29
-rw-r--r--libguile/vm-i-system.c52
3 files changed, 48 insertions, 35 deletions
diff --git a/libguile/programs.c b/libguile/programs.c
index dfa6196d4..666b94fbf 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -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"));
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index c86307c86..516eedcb4 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -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]
/*
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 259e93861..9f75dff52 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -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 */