Use offsets relative to top rather than bottom for stack refs

* lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-and-error-free-ops):
Remove interactive-p.
(byte-optimize-lapcode): Update optimizations now that stack-refs are
relative to the top rather than to the bottom.
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode):
Turn stack-ref-0 into dup.
(byte-compile-form): Don't indirect-function since it can signal
errors.
(byte-compile-stack-ref, byte-compile-stack-set): Adjust to stack-refs
being relative to top rather than to bottom in the byte-code.
(with-output-to-temp-buffer): Remove.
(byte-compile-with-output-to-temp-buffer): Remove.
* lisp/emacs-lisp/cconv.el: Use lexical-binding.
(cconv--lookup-let): Rename from cconv-lookup-let.
(cconv-closure-convert-rec): Fix handling of captured+mutated
arguments in defun/defmacro.
* lisp/emacs-lisp/eieio-comp.el (eieio-byte-compile-file-form-defmethod):
Rename from byte-compile-file-form-defmethod.
Don't byte-compile-lambda.
(eieio-byte-compile-defmethod-param-convert): Rename from
byte-compile-defmethod-param-convert.
* lisp/emacs-lisp/eieio.el (eieio-defgeneric-form-primary-only-one):
Call byte-compile rather than byte-compile-lambda.
* src/alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly.
* src/bytecode.c (exec_byte_code): Change stack_ref and stack_set to use
offsets relative to top rather than to bottom.
* lisp/subr.el (with-output-to-temp-buffer): New macro.
* lisp/simple.el (count-words-region): Don't use interactive-p.

5 files changed, 53 insertions, 77 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 6bebce0abaa..d522b6c55dc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2011-02-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * bytecode.c (exec_byte_code): Change stack_ref and stack_set to use
+        offsets relative to top rather than to bottom.
+
+        * alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly.
+
 2011-02-19  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * window.c (Fsave_window_excursion): Remove.  Moved to Lisp.
diff --git a/src/alloc.c b/src/alloc.c
index 36c849418f3..4c29ce0b4ec 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5029,9 +5029,9 @@ returns nil, because real GC can't be done.  */)
       for (i = 0; i < tail->nvars; i++)
         mark_object (tail->var[i]);
   }
+  mark_byte_stack ();
 #endif
 
-  mark_byte_stack ();
   for (catch = catchlist; catch; catch = catch->next)
     {
       mark_object (catch->tag);
diff --git a/src/bytecode.c b/src/bytecode.c
index ad2f7d18ade..b2e9e3c5b56 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -51,7 +51,7 @@ by Hallvard:
  *
  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
  */
-/* #define BYTE_CODE_SAFE */
+#define BYTE_CODE_SAFE
 /* #define BYTE_CODE_METER */
 
 
@@ -88,7 +88,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
 
 /*  Byte codes: */
 
-#define Bstack_ref 0
+#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup.  */
 #define Bvarref 010
 #define Bvarset 020
 #define Bvarbind 030
@@ -189,8 +189,8 @@ extern Lisp_Object Qand_optional, Qand_rest;
 
 #define Bunwind_protect 0216
 #define Bcondition_case 0217
-#define Btemp_output_buffer_setup 0220
-#define Btemp_output_buffer_show 0221
+#define Btemp_output_buffer_setup 0220 /* Obsolete.  */
+#define Btemp_output_buffer_show 0221  /* Obsolete.  */
 
 #define Bunbind_all 0222        /* Obsolete.  */
 
@@ -898,9 +898,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 
         case Bsave_window_excursion: /* Obsolete.  */
           {
-            register Lisp_Object val;
             register int count = SPECPDL_INDEX ();
-
             record_unwind_protect (Fset_window_configuration,
                                    Fcurrent_window_configuration (Qnil));
             BEFORE_POTENTIAL_GC ();
@@ -940,7 +938,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
             break;
           }
 
-        case Btemp_output_buffer_setup:
+        case Btemp_output_buffer_setup: /* Obsolete.  */
           BEFORE_POTENTIAL_GC ();
           CHECK_STRING (TOP);
           temp_output_buffer_setup (SSDATA (TOP));
@@ -948,7 +946,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
           TOP = Vstandard_output;
           break;
 
-        case Btemp_output_buffer_show:
+        case Btemp_output_buffer_show: /* Obsolete.  */
           {
             Lisp_Object v1;
             BEFORE_POTENTIAL_GC ();
@@ -1710,26 +1708,42 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 #endif
 
           /* Handy byte-codes for lexical binding.  */
-        case Bstack_ref:
+          /* case Bstack_ref: */  /* Use `dup' instead.  */
         case Bstack_ref+1:
         case Bstack_ref+2:
         case Bstack_ref+3:
         case Bstack_ref+4:
         case Bstack_ref+5:
-          PUSH (stack.bottom[op - Bstack_ref]);
-          break;
+          {
+            Lisp_Object *ptr = top - (op - Bstack_ref);
+            PUSH (*ptr);
+            break;
+          }
         case Bstack_ref+6:
-          PUSH (stack.bottom[FETCH]);
-          break;
+          {
+            Lisp_Object *ptr = top - (FETCH);
+            PUSH (*ptr);
+            break;
+          }
         case Bstack_ref+7:
-          PUSH (stack.bottom[FETCH2]);
-          break;
+          {
+            Lisp_Object *ptr = top - (FETCH2);
+            PUSH (*ptr);
+            break;
+          }
+          /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
         case Bstack_set:
-          stack.bottom[FETCH] = POP;
-          break;
+          {
+            Lisp_Object *ptr = top - (FETCH);
+            *ptr = POP;
+            break;
+          }
         case Bstack_set2:
-          stack.bottom[FETCH2] = POP;
-          break;
+          {
+            Lisp_Object *ptr = top - (FETCH2);
+            *ptr = POP;
+            break;
+          }
         case BdiscardN:
           op = FETCH;
           if (op & 0x80)
diff --git a/src/print.c b/src/print.c
index 2c4762047ac..f48b618775d 100644
--- a/src/print.c
+++ b/src/print.c
@@ -524,6 +524,7 @@ temp_output_buffer_setup (const char *bufname)
   specbind (Qstandard_output, buf);
 }
 
+/* FIXME: Use Lisp's with-output-to-temp-buffer instead!  */
 Lisp_Object
 internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args)
 {
@@ -545,60 +546,6 @@ internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function
 
   return unbind_to (count, val);
 }
-
-DEFUN ("with-output-to-temp-buffer",
-       Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
-       1, UNEVALLED, 0,
-       doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
-
-This construct makes buffer BUFNAME empty before running BODY.
-It does not make the buffer current for BODY.
-Instead it binds `standard-output' to that buffer, so that output
-generated with `prin1' and similar functions in BODY goes into
-the buffer.
-
-At the end of BODY, this marks buffer BUFNAME unmodifed and displays
-it in a window, but does not select it.  The normal way to do this is
-by calling `display-buffer', then running `temp-buffer-show-hook'.
-However, if `temp-buffer-show-function' is non-nil, it calls that
-function instead (and does not run `temp-buffer-show-hook').  The
-function gets one argument, the buffer to display.
-
-The return value of `with-output-to-temp-buffer' is the value of the
-last form in BODY.  If BODY does not finish normally, the buffer
-BUFNAME is not displayed.
-
-This runs the hook `temp-buffer-setup-hook' before BODY,
-with the buffer BUFNAME temporarily current.  It runs the hook
-`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
-buffer temporarily current, and the window that was used to display it
-temporarily selected.  But it doesn't run `temp-buffer-show-hook'
-if it uses `temp-buffer-show-function'.
-
-usage: (with-output-to-temp-buffer BUFNAME BODY...)  */)
-  (Lisp_Object args)
-{
-  struct gcpro gcpro1;
-  Lisp_Object name;
-  int count = SPECPDL_INDEX ();
-  Lisp_Object buf, val;
-
-  GCPRO1(args);
-  name = eval_sub (Fcar (args));
-  CHECK_STRING (name);
-  temp_output_buffer_setup (SSDATA (name));
-  buf = Vstandard_output;
-  UNGCPRO;
-
-  val = Fprogn (XCDR (args));
-
-  GCPRO1 (val);
-  temp_output_buffer_show (buf);
-  UNGCPRO;
-
-  return unbind_to (count, val);
-}
-
 
 static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
 static void print_preprocess (Lisp_Object obj);
@@ -2310,6 +2257,4 @@ priorities.  */);
 
   print_prune_charset_plist = Qnil;
   staticpro (&print_prune_charset_plist);
-
-  defsubr (&Swith_output_to_temp_buffer);
 }
diff --git a/src/window.c b/src/window.c
index c90cc268a92..d21cbb164ea 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3655,7 +3655,6 @@ displaying that buffer.  */)
   return Qnil;
 }
 
-
 void
 temp_output_buffer_show (register Lisp_Object buf)
 {
@@ -3715,6 +3714,16 @@ temp_output_buffer_show (register Lisp_Object buf)
         }
     }
 }
+
+DEFUN ("internal-temp-output-buffer-show",
+       Ftemp_output_buffer_show, Stemp_output_buffer_show,
+       1, 1, 0,
+       doc: /* Internal function for `with-output-to-temp-buffer''.  */)
+     (Lisp_Object buf)
+{
+  temp_output_buffer_show (buf);
+  return Qnil;
+}
 
 static void
 make_dummy_parent (Lisp_Object window)
@@ -7155,6 +7164,7 @@ frame to be redrawn only if it is a tty frame.  */);
   defsubr (&Sset_window_buffer);
   defsubr (&Sselect_window);
   defsubr (&Sforce_window_update);
+  defsubr (&Stemp_output_buffer_show);
   defsubr (&Ssplit_window);
   defsubr (&Senlarge_window);
   defsubr (&Sshrink_window);