X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/741baf7656eb6738d7b4160493c969fad2640e1b..59b7fa6569f8b865b6ef688a8531d745f1cc67d4:/src/bytecode.c

diff --git a/src/bytecode.c b/src/bytecode.c
index 363dcdfaa8..f24132dae2 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1,5 +1,6 @@
 /* Execution of byte code produced by bytecomp.el.
-   Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -65,16 +66,16 @@ int byte_metering_on;
 
 #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_CODE(last_code, this_code)				\
+{									\
+  if (byte_metering_on)							\
+    {									\
+      if (METER_1 (this_code) < MOST_POSITIVE_FIXNUM)			\
+        METER_1 (this_code)++;						\
+      if (last_code							\
+	  && METER_2 (last_code, this_code) < MOST_POSITIVE_FIXNUM)	\
+        METER_2 (last_code, this_code)++;				\
+    }									\
 }
 
 #else /* no BYTE_CODE_METER */
@@ -396,14 +397,27 @@ unmark_byte_stack ()
 
 #endif /* not BYTE_CODE_SAFE */
 
+/* A version of the QUIT macro which makes sure that the stack top is
+   set before signaling `quit'.  */
+
+#define BYTE_CODE_QUIT					\
+  do {							\
+    if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))	\
+      {							\
+	Vquit_flag = Qnil;				\
+        BEFORE_POTENTIAL_GC ();				\
+	Fsignal (Qquit, Qnil);				\
+      }							\
+  } while (0)
+
 
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
-  "Function used internally in byte-compiled code.\n\
-The first argument, BYTESTR, is a string of byte code;\n\
-the second, VECTOR, a vector of constants;\n\
-the third, MAXDEPTH, the maximum stack depth used in this function.\n\
-If the third argument is incorrect, Emacs may crash.")
-  (bytestr, vector, maxdepth)
+       doc: /* Function used internally in byte-compiled code.
+The first argument, BYTESTR, is a string of byte code;
+the second, VECTOR, a vector of constants;
+the third, MAXDEPTH, the maximum stack depth used in this function.
+If the third argument is incorrect, Emacs may crash.  */)
+     (bytestr, vector, maxdepth)
      Lisp_Object bytestr, vector, maxdepth;
 {
   int count = specpdl_ptr - specpdl;
@@ -433,17 +447,17 @@ If the third argument is incorrect, Emacs may crash.")
  }
 #endif
 
-  CHECK_STRING (bytestr, 0);
+  CHECK_STRING (bytestr);
   if (!VECTORP (vector))
     vector = wrong_type_argument (Qvectorp, vector);
-  CHECK_NUMBER (maxdepth, 2);
+  CHECK_NUMBER (maxdepth);
 
   if (STRING_MULTIBYTE (bytestr))
     /* BYTESTR must have been produced by Emacs 20.2 or the earlier
        because they produced a raw 8-bit string for byte-code and now
        such a byte-code string is loaded as multibyte while raw 8-bit
        characters converted to multibyte form.  Thus, now we must
-       convert them back to the original unibyte form.  */
+       convert them back to the originally intended unibyte form.  */
     bytestr = Fstring_as_unibyte (bytestr);
 
   bytestr_length = STRING_BYTES (XSTRING (bytestr));
@@ -506,7 +520,7 @@ If the third argument is incorrect, Emacs may crash.")
 	    v1 = vectorp[op];
 	    if (SYMBOLP (v1))
 	      {
-		v2 = XSYMBOL (v1)->value;
+		v2 = SYMBOL_VALUE (v1);
 		if (MISCP (v2) || EQ (v2, Qunbound))
 		  {
 		    BEFORE_POTENTIAL_GC ();
@@ -529,7 +543,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  op = FETCH2;
 	  if (NILP (POP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      CHECK_RANGE (op);
 	      stack.pc = stack.byte_string_start + op;
 	    }
@@ -612,16 +626,9 @@ If the third argument is incorrect, Emacs may crash.")
 	    /* Inline the most common case.  */
 	    if (SYMBOLP (sym)
 		&& !EQ (val, Qunbound)
-		&& !MISCP (XSYMBOL (sym)->value)
-		/* I think this should either be checked in the byte
-		   compiler, or there should be a flag indicating that
-		   a symbol might be constant in Lisp_Symbol, instead
-		   of checking this here over and over again. --gerd.  */
-		&& !EQ (sym, Qnil)
-		&& !EQ (sym, Qt)
-		&& !(XSYMBOL (sym)->name->data[0] == ':'
-		     && EQ (XSYMBOL (sym)->obarray, initial_obarray)
-		     && !EQ (val, sym)))
+		&& !XSYMBOL (sym)->indirect_variable
+		&& !XSYMBOL (sym)->constant
+		&& !MISCP (XSYMBOL (sym)->value))
 	      XSYMBOL (sym)->value = val;
 	    else
 	      {
@@ -692,7 +699,7 @@ If the third argument is incorrect, Emacs may crash.")
 		v1 = TOP;
 		v2 = Fget (v1, Qbyte_code_meter);
 		if (INTEGERP (v2)
-		    && XINT (v2) != ((1<<VALBITS)-1))
+		    && XINT (v2) < MOST_POSITIVE_FIXNUM)
 		  {
 		    XSETINT (v2, XINT (v2) + 1);
 		    Fput (v1, Qbyte_code_meter, v2);
@@ -735,7 +742,7 @@ If the third argument is incorrect, Emacs may crash.")
 
 	case Bgoto:
 	  MAYBE_GC ();
-	  QUIT;
+	  BYTE_CODE_QUIT;
 	  op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
 	  CHECK_RANGE (op);
 	  stack.pc = stack.byte_string_start + op;
@@ -746,7 +753,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  op = FETCH2;
 	  if (!NILP (POP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      CHECK_RANGE (op);
 	      stack.pc = stack.byte_string_start + op;
 	    }
@@ -757,7 +764,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  op = FETCH2;
 	  if (NILP (TOP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      CHECK_RANGE (op);
 	      stack.pc = stack.byte_string_start + op;
 	    }
@@ -769,7 +776,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  op = FETCH2;
 	  if (!NILP (TOP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      CHECK_RANGE (op);
 	      stack.pc = stack.byte_string_start + op;
 	    }
@@ -778,7 +785,7 @@ If the third argument is incorrect, Emacs may crash.")
 
 	case BRgoto:
 	  MAYBE_GC ();
-	  QUIT;
+	  BYTE_CODE_QUIT;
 	  stack.pc += (int) *stack.pc - 127;
 	  break;
 
@@ -786,7 +793,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  MAYBE_GC ();
 	  if (NILP (POP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      stack.pc += (int) *stack.pc - 128;
 	    }
 	  stack.pc++;
@@ -796,7 +803,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  MAYBE_GC ();
 	  if (!NILP (POP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      stack.pc += (int) *stack.pc - 128;
 	    }
 	  stack.pc++;
@@ -807,7 +814,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  op = *stack.pc++;
 	  if (NILP (TOP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      stack.pc += op - 128;
 	    }
 	  else DISCARD (1);
@@ -818,7 +825,7 @@ If the third argument is incorrect, Emacs may crash.")
 	  op = *stack.pc++;
 	  if (!NILP (TOP))
 	    {
-	      QUIT;
+	      BYTE_CODE_QUIT;
 	      stack.pc += op - 128;
 	    }
 	  else DISCARD (1);
@@ -888,7 +895,7 @@ If the third argument is incorrect, Emacs may crash.")
 
 	case Btemp_output_buffer_setup:
 	  BEFORE_POTENTIAL_GC ();
-	  CHECK_STRING (TOP, 0);
+	  CHECK_STRING (TOP);
 	  temp_output_buffer_setup (XSTRING (TOP)->data);
 	  AFTER_POTENTIAL_GC ();
 	  TOP = Vstandard_output;
@@ -913,7 +920,7 @@ If the third argument is incorrect, Emacs may crash.")
 	    BEFORE_POTENTIAL_GC ();
 	    v1 = POP;
 	    v2 = TOP;
-	    CHECK_NUMBER (v2, 0);
+	    CHECK_NUMBER (v2);
 	    AFTER_POTENTIAL_GC ();
 	    op = XINT (v2);
 	    immediate_quit = 1;
@@ -1145,8 +1152,8 @@ If the third argument is incorrect, Emacs may crash.")
 	    Lisp_Object v1, v2;
 	    BEFORE_POTENTIAL_GC ();
 	    v2 = POP; v1 = TOP;
-	    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
-	    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
+	    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
+	    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
 	    AFTER_POTENTIAL_GC ();
 	    if (FLOATP (v1) || FLOATP (v2))
 	      {
@@ -1427,7 +1434,7 @@ If the third argument is incorrect, Emacs may crash.")
 
 	case Bchar_syntax:
 	  BEFORE_POTENTIAL_GC ();
-	  CHECK_NUMBER (TOP, 0);
+	  CHECK_NUMBER (TOP);
 	  AFTER_POTENTIAL_GC ();
 	  XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
 	  break;
@@ -1556,7 +1563,7 @@ If the third argument is incorrect, Emacs may crash.")
 		BEFORE_POTENTIAL_GC ();
 		v2 = POP;
 		v1 = TOP;
-		CHECK_NUMBER (v2, 0);
+		CHECK_NUMBER (v2);
 		AFTER_POTENTIAL_GC ();
 		op = XINT (v2);
 		immediate_quit = 1;
@@ -1739,17 +1746,18 @@ 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.\n\
-(aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
-opcode CODE has been executed.\n\
-(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
-indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
-executed in succession.");
+	       doc: /* A vector of vectors which holds a histogram of byte-code usage.
+\(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
+opcode CODE has been executed.
+\(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
+indicates how many times the byte opcodes CODE1 and CODE2 have been
+executed in succession.  */);
+  
   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
-   "If non-nil, keep profiling information on byte code usage.\n\
-The variable byte-code-meter indicates how often each byte opcode is used.\n\
-If a symbol has a property named `byte-code-meter' whose value is an\n\
-integer, it is incremented each time that symbol's function is called.");
+	       doc: /* If non-nil, keep profiling information on byte code usage.
+The variable byte-code-meter indicates how often each byte opcode is used.
+If a symbol has a property named `byte-code-meter' whose value is an
+integer, it is incremented each time that symbol's function is called.  */);
 
   byte_metering_on = 0;
   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));