From 28106f547dc88723e02a38de7d4dc4ffc6434590 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sat, 13 Sep 2008 15:41:43 +0200
Subject: [PATCH] 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.
---
 libguile/programs.c    |  2 +-
 libguile/vm-engine.h   | 29 -----------------------
 libguile/vm-i-system.c | 52 ++++++++++++++++++++++++++++++++++++++----
 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 */