entered into RCS

1 files changed, 85 insertions, 182 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index 5ab689f192..f888a68b7f 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 [email protected] 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
 }