entered into RCS

1 files changed, 85 insertions, 182 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index 5ab689f1925..f888a68b7f6 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1,11 +1,11 @@
 /* Execution of byte code produced by bytecomp.el.
-   Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 1, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -17,12 +17,14 @@ You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
-hacked on by jwz@lucid.com 17-jun-91
+hacked on by jwz 17-jun-91
   o  added a compile-time switch to turn on simple sanity checking;
   o  put back the obsolete byte-codes for error-detection;
+  o  put back fset, symbol-function, and read-char because I don't
+     see any reason for them to have been removed;
   o  added a new instruction, unbind_all, which I will use for 
      tail-recursion elimination;
-  o  made temp_output_buffer_show be called with the right number
+  o  made temp_output_buffer_show() be called with the right number
      of args;
   o  made the new bytecodes be called with args in the right order;
   o  added metering support.
@@ -32,49 +34,48 @@ by Hallvard:
   o  all conditionals now only do QUIT if they jump.
  */
 
+
 #include "config.h"
 #include "lisp.h"
 #include "buffer.h"
 #include "syntax.h"
 
-/*
- * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
- * debugging the byte compiler...)
- *
- * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 
+/* Define this to enable some minor sanity checking
+   (useful for debugging the byte compiler...)
+ */
+#define BYTE_CODE_SAFE
+
+/* Define this to enable generation of a histogram of byte-op usage.
  */
-/* #define BYTE_CODE_SAFE */
-/* #define BYTE_CODE_METER */
+#define BYTE_CODE_METER
 
 
 #ifdef BYTE_CODE_METER
 
-Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
+Lisp_Object Vbyte_code_meter;
 int byte_metering_on;
 
-#define METER_2(code1, code2) \
+# define METER_2(code1,code2) \
   XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
             ->contents[(code2)])
 
-#define METER_1(code) METER_2 (0, (code))
-
-#define METER_CODE(last_code, this_code)                        \
-{                                                               \
-  if (byte_metering_on)                                         \
-    {                                                           \
-      if (METER_1 (this_code) != ((1<<VALBITS)-1))              \
-        METER_1 (this_code)++;                                  \
-      if (last_code                                             \
-          && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))        \
-        METER_2 (last_code, this_code)++;                       \
-    }                                                           \
-}
+# define METER_1(code) METER_2 (0,(code))
 
-#else /* no BYTE_CODE_METER */
+# define METER_CODE(last_code, this_code) {                     \
+  if (byte_metering_on) {                                       \
+     if (METER_1 (this_code) != ((1<<VALBITS)-1))               \
+        METER_1 (this_code) ++;                                 \
+     if (last_code &&                                           \
+        METER_2 (last_code,this_code) != ((1<<VALBITS)-1))      \
+        METER_2 (last_code,this_code) ++;                       \
+  }                                                             \
+ }
 
-#define METER_CODE(last_code, this_code)
+#else /* ! BYTE_CODE_METER */
 
-#endif /* no BYTE_CODE_METER */
+# define meter_code(last_code, this_code)
+
+#endif
 
 
 Lisp_Object Qbytecode;
@@ -146,7 +147,7 @@ Lisp_Object Qbytecode;
 #define Bbobp 0157
 #define Bcurrent_buffer 0160
 #define Bset_buffer 0161
-#define Bread_char 0162 /* No longer generated as of v19 */
+#define Bread_char 0162
 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
 
@@ -160,7 +161,6 @@ Lisp_Object Qbytecode;
 #define Bdelete_region 0174
 #define Bnarrow_to_region 0175
 #define Bwiden 0176
-#define Bend_of_line 0177
 
 #define Bconstant2 0201
 #define Bgoto 0202
@@ -184,12 +184,6 @@ Lisp_Object Qbytecode;
 
 #define Bunbind_all 0222
 
-#define Bset_marker 0223
-#define Bmatch_beginning 0224
-#define Bmatch_end 0225
-#define Bupcase 0226
-#define Bdowncase 0227
-
 #define Bstringeqlsign 0230
 #define Bstringlss 0231
 #define Bequal 0232
@@ -208,16 +202,6 @@ Lisp_Object Qbytecode;
 #define Bnumberp 0247
 #define Bintegerp 0250
 
-#define BRgoto 0252
-#define BRgotoifnil 0253
-#define BRgotoifnonnil 0254
-#define BRgotoifnilelsepop 0255
-#define BRgotoifnonnilelsepop 0256
-
-#define BlistN 0257
-#define BconcatN 0260
-#define BinsertN 0261
-
 #define Bconstant 0300
 #define CONSTANTLIM 0100
 
@@ -301,10 +285,11 @@ If the third argument is incorrect, Emacs may crash.")
     {
 #ifdef BYTE_CODE_SAFE
       if (stackp > stacke)
-        error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
+        error (
+     "Stack overflow in byte code (byte compiler bug), pc = %d, depth = %d",
                pc - XSTRING (string_saved)->data, stacke - stackp);
       if (stackp < stack)
-        error ("Byte code stack underflow (byte compiler bug), pc %d",
+        error ("Stack underflow in byte code (byte compiler bug), pc = %d",
                pc - XSTRING (string_saved)->data);
 #endif
 
@@ -405,19 +390,7 @@ If the third argument is incorrect, Emacs may crash.")
         case Bcall+4: case Bcall+5:
           op -= Bcall;
         docall:
-          DISCARD (op);
-#ifdef BYTE_CODE_METER
-          if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
-            {
-              v1 = TOP;
-              v2 = Fget (v1, Qbyte_code_meter);
-              if (XTYPE (v2) == Lisp_Int)
-                {
-                  XSETINT (v2, XINT (v2) + 1);
-                  Fput (v1, Qbyte_code_meter, v2);
-                }
-            }
-#endif
+          DISCARD(op);
           TOP = Ffuncall (op + 1, &TOP);
           break;
 
@@ -438,7 +411,8 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bunbind_all:
           /* To unbind back to the beginning of this frame.  Not used yet,
-             but will be needed for tail-recursion elimination.  */
+             but wil be needed for tail-recursion elimination.
+           */
           unbind_to (count, Qnil);
           break;
 
@@ -450,7 +424,7 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bgotoifnil:
           op = FETCH2;
-          if (NILP (POP))
+          if (NULL (POP))
             {
               QUIT;
               pc = XSTRING (string_saved)->data + op;
@@ -459,7 +433,7 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bgotoifnonnil:
           op = FETCH2;
-          if (!NILP (POP))
+          if (!NULL (POP))
             {
               QUIT;
               pc = XSTRING (string_saved)->data + op;
@@ -468,65 +442,22 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bgotoifnilelsepop:
           op = FETCH2;
-          if (NILP (TOP))
+          if (NULL (TOP))
             {
               QUIT;
               pc = XSTRING (string_saved)->data + op;
             }
-          else DISCARD (1);
+          else DISCARD(1);
           break;
 
         case Bgotoifnonnilelsepop:
           op = FETCH2;
-          if (!NILP (TOP))
+          if (!NULL (TOP))
             {
               QUIT;
               pc = XSTRING (string_saved)->data + op;
             }
-          else DISCARD (1);
-          break;
-
-        case BRgoto:
-          QUIT;
-          pc += *pc - 127;
-          break;
-
-        case BRgotoifnil:
-          if (NILP (POP))
-            {
-              QUIT;
-              pc += *pc - 128;
-            }
-          pc++;
-          break;
-
-        case BRgotoifnonnil:
-          if (!NILP (POP))
-            {
-              QUIT;
-              pc += *pc - 128;
-            }
-          pc++;
-          break;
-
-        case BRgotoifnilelsepop:
-          op = *pc++;
-          if (NILP (TOP))
-            {
-              QUIT;
-              pc += op - 128;
-            }
-          else DISCARD (1);
-          break;
-
-        case BRgotoifnonnilelsepop:
-          op = *pc++;
-          if (!NILP (TOP))
-            {
-              QUIT;
-              pc += op - 128;
-            }
-          else DISCARD (1);
+          else DISCARD(1);
           break;
 
         case Breturn:
@@ -534,7 +465,7 @@ If the third argument is incorrect, Emacs may crash.")
           goto exit;
 
         case Bdiscard:
-          DISCARD (1);
+          DISCARD(1);
           break;
 
         case Bdup:
@@ -598,7 +529,7 @@ If the third argument is incorrect, Emacs may crash.")
             {
               if (CONSP (v1))
                 v1 = XCONS (v1)->cdr;
-              else if (!NILP (v1))
+              else if (!NULL (v1))
                 {
                   immediate_quit = 0;
                   v1 = wrong_type_argument (Qlistp, v1);
@@ -622,7 +553,7 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Blistp:
-          TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
+          TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil;
           break;
 
         case Beq:
@@ -636,21 +567,21 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Bnot:
-          TOP = NILP (TOP) ? Qt : Qnil;
+          TOP = NULL (TOP) ? Qt : Qnil;
           break;
 
         case Bcar:
           v1 = TOP;
         docar:
           if (CONSP (v1)) TOP = XCONS (v1)->car;
-          else if (NILP (v1)) TOP = Qnil;
+          else if (NULL (v1)) TOP = Qnil;
           else Fcar (wrong_type_argument (Qlistp, v1));
           break;
 
         case Bcdr:
           v1 = TOP;
           if (CONSP (v1)) TOP = XCONS (v1)->cdr;
-          else if (NILP (v1)) TOP = Qnil;
+          else if (NULL (v1)) TOP = Qnil;
           else Fcdr (wrong_type_argument (Qlistp, v1));
           break;
 
@@ -669,21 +600,15 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Blist3:
-          DISCARD (2);
+          DISCARD(2);
           TOP = Flist (3, &TOP);
           break;
 
         case Blist4:
-          DISCARD (3);
+          DISCARD(3);
           TOP = Flist (4, &TOP);
           break;
 
-        case BlistN:
-          op = FETCH;
-          DISCARD (op - 1);
-          TOP = Flist (op, &TOP);
-          break;
-
         case Blength:
           TOP = Flength (TOP);
           break;
@@ -727,26 +652,20 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Bconcat2:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fconcat (2, &TOP);
           break;
 
         case Bconcat3:
-          DISCARD (2);
+          DISCARD(2);
           TOP = Fconcat (3, &TOP);
           break;
 
         case Bconcat4:
-          DISCARD (3);
+          DISCARD(3);
           TOP = Fconcat (4, &TOP);
           break;
 
-        case BconcatN:
-          op = FETCH;
-          DISCARD (op - 1);
-          TOP = Fconcat (op, &TOP);
-          break;
-
         case Bsub1:
           v1 = TOP;
           if (XTYPE (v1) == Lisp_Int)
@@ -797,7 +716,7 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Bdiff:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fminus (2, &TOP);
           break;
 
@@ -813,32 +732,33 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Bplus:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fplus (2, &TOP);
           break;
 
         case Bmax:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fmax (2, &TOP);
           break;
 
         case Bmin:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fmin (2, &TOP);
           break;
 
         case Bmult:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Ftimes (2, &TOP);
           break;
 
         case Bquo:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fquo (2, &TOP);
           break;
 
         case Brem:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Frem (TOP, v1);
           break;
 
@@ -855,12 +775,6 @@ If the third argument is incorrect, Emacs may crash.")
           TOP = Finsert (1, &TOP);
           break;
 
-        case BinsertN:
-          op = FETCH;
-          DISCARD (op - 1);
-          TOP = Finsert (op, &TOP);
-          break;
-
         case Bpoint_max:
           XFASTINT (v1) = ZV;
           PUSH (v1);
@@ -928,24 +842,29 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Bforward_char:
+          /* This was wrong!  --jwz */
           TOP = Fforward_char (TOP);
           break;
 
         case Bforward_word:
+          /* This was wrong!  --jwz */
           TOP = Fforward_word (TOP);
           break;
 
         case Bskip_chars_forward:
+          /* This was wrong!  --jwz */
           v1 = POP;
           TOP = Fskip_chars_forward (TOP, v1);
           break;
 
         case Bskip_chars_backward:
+          /* This was wrong!  --jwz */
           v1 = POP;
           TOP = Fskip_chars_backward (TOP, v1);
           break;
 
         case Bforward_line:
+          /* This was wrong!  --jwz */
           TOP = Fforward_line (TOP);
           break;
 
@@ -961,11 +880,13 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bdelete_region:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fdelete_region (TOP, v1);
           break;
 
         case Bnarrow_to_region:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fnarrow_to_region (TOP, v1);
           break;
 
@@ -973,49 +894,27 @@ If the third argument is incorrect, Emacs may crash.")
           PUSH (Fwiden ());
           break;
 
-        case Bend_of_line:
-          TOP = Fend_of_line (TOP);
-          break;
-
-        case Bset_marker:
-          v1 = POP;
-          v2 = POP;
-          TOP = Fset_marker (TOP, v2, v1);
-          break;
-
-        case Bmatch_beginning:
-          TOP = Fmatch_beginning (TOP);
-          break;
-
-        case Bmatch_end:
-          TOP = Fmatch_end (TOP);
-          break;
-
-        case Bupcase:
-          TOP = Fupcase (TOP);
-          break;
-
-        case Bdowncase:
-          TOP = Fdowncase (TOP);
-        break;
-
         case Bstringeqlsign:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fstring_equal (TOP, v1);
           break;
 
         case Bstringlss:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fstring_lessp (TOP, v1);
           break;
 
         case Bequal:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fequal (TOP, v1);
           break;
 
         case Bnthcdr:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fnthcdr (TOP, v1);
           break;
 
@@ -1033,11 +932,13 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bmember:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fmember (TOP, v1);
           break;
 
         case Bassq:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fassq (TOP, v1);
           break;
 
@@ -1047,11 +948,13 @@ If the third argument is incorrect, Emacs may crash.")
 
         case Bsetcar:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fsetcar (TOP, v1);
           break;
 
         case Bsetcdr:
           v1 = POP;
+          /* This had args in the wrong order.  -- jwz */
           TOP = Fsetcdr (TOP, v1);
           break;
 
@@ -1072,12 +975,13 @@ If the third argument is incorrect, Emacs may crash.")
           break;
 
         case Bnconc:
-          DISCARD (1);
+          DISCARD(1);
           TOP = Fnconc (2, &TOP);
           break;
 
         case Bnumberp:
-          TOP = (NUMBERP (TOP) ? Qt : Qnil);
+          TOP = (XTYPE (TOP) == Lisp_Int || XTYPE (TOP) == Lisp_Float
+                 ? Qt : Qnil);
           break;
 
         case Bintegerp:
@@ -1092,7 +996,7 @@ If the third argument is incorrect, Emacs may crash.")
           error ("scan-buffer is an obsolete bytecode");
           break;
         case Bmark:
-          error ("mark is an obsolete bytecode");
+          error("mark is an obsolete bytecode");
           break;
 #endif
 
@@ -1131,18 +1035,17 @@ syms_of_bytecode ()
 #ifdef BYTE_CODE_METER
 
   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
-   "A vector of vectors which holds a histogram of byte-code usage.");
+   "a vector of vectors which holds a histogram of byte-code usage.");
   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, "");
 
   byte_metering_on = 0;
-  Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
-  Qbyte_code_meter = intern ("byte-code-meter");
-  staticpro (&Qbyte_code_meter);
+  Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0));
+
   {
     int i = 256;
     while (i--)
-      XVECTOR (Vbyte_code_meter)->contents[i] =
-        Fmake_vector (make_number (256), make_number (0));
+      XVECTOR(Vbyte_code_meter)->contents[i] =
+        Fmake_vector(make_number(256), make_number(0));
   }
 #endif
 }