Re: tail-call elimination

[Chris Gray]

Hello,

Based on feedback by Stefan, I have updated the patch.  This is a
slightly less "pure" version of TCO than the original patch, but it
should be faster.  (And really, the difference between this and the
"pure" version is pretty much academic.)

Cheers,
Chris

diff --git a/src/bytecode.c b/src/bytecode.c
index 4c5ac15..16495ea 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -45,6 +45,8 @@ by Hallvard:
 #include "xterm.h"
 #endif
 
+Lisp_Object Ffetch_bytecode (Lisp_Object);
+
 /*
  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
  * debugging the byte compiler...)
@@ -498,7 +500,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
   ptrdiff_t bytestr_length;
 #endif
   struct byte_stack stack;
-  Lisp_Object *top;
+  Lisp_Object *top = NULL;
+  Lisp_Object *bottom = NULL;
   Lisp_Object result;
 
 #if 0 /* CHECK_FRAME_FONT */
@@ -511,6 +514,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
  }
 #endif
 
+  stack.next = byte_stack_list;
+  byte_stack_list = &stack;
+
   CHECK_STRING (bytestr);
   CHECK_VECTOR (vector);
   CHECK_NATNUM (maxdepth);
@@ -532,18 +538,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
 #endif
   vectorp = XVECTOR (vector)->contents;
 
-  stack.byte_string = bytestr;
-  stack.pc = stack.byte_string_start = SDATA (bytestr);
-  stack.constants = vector;
   if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
     memory_full (SIZE_MAX);
   top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
+  bottom = top;
+
+ tail_call:
+  CHECK_STRING (bytestr);
+  CHECK_VECTOR (vector);
+  CHECK_NATNUM (maxdepth);
+  stack.byte_string = bytestr;
+  stack.pc = stack.byte_string_start = SDATA (bytestr);
+  stack.constants = vector;
+  vectorp = XVECTOR (vector)->contents;
+  
 #if BYTE_MAINTAIN_TOP
   stack.bottom = top + 1;
   stack.top = NULL;
 #endif
-  stack.next = byte_stack_list;
-  byte_stack_list = &stack;
 
 #ifdef BYTE_CODE_SAFE
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
@@ -894,6 +906,45 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, 
Lisp_Object maxdepth,
                  }
              }
 #endif
+            /* If the next op is return, maybe we can eliminate the tail call 
*/
+            if (*stack.pc == Breturn)
+              {
+                Lisp_Object fun, original_fun, syms_left;
+                fun = original_fun = TOP;
+                
+                if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+                    && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+                  fun = indirect_function (fun);
+                if (COMPILEDP(fun))
+                  {
+                    syms_left = AREF (fun, COMPILED_ARGLIST);
+                    if (INTEGERP (syms_left))
+                      {
+                        int i;
+                        int prev_maxdepth = XFASTINT(maxdepth);
+                        if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+                          Ffetch_bytecode (fun);
+                        bytestr = AREF (fun, COMPILED_BYTECODE);
+                        vector = AREF (fun, COMPILED_CONSTANTS);
+                        maxdepth = AREF (fun, COMPILED_STACK_DEPTH);
+                        args_template = syms_left;
+                        nargs = op;
+                        args = top + 1;
+                        if (XFASTINT(maxdepth) > prev_maxdepth)
+                          {
+                              if (MAX_ALLOCA / word_size <= XFASTINT 
(maxdepth))
+                                memory_full (SIZE_MAX);
+                              top = alloca ((XFASTINT (maxdepth) + 1) * sizeof 
*top);
+                              bottom = top;
+                          }
+                        else
+                          {
+                            top = bottom;
+                          }
+                        goto tail_call;
+                      }
+                  }
+              }
            TOP = Ffuncall (op + 1, &TOP);
            AFTER_POTENTIAL_GC ();
            NEXT;