X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/089b985ff9f2d34e99b4c62c928c461ffc0bf2a9..d4881c6acbb41cfd507b533efdd2cdaaf5eac204:/src/bytecode.c

diff --git a/src/bytecode.c b/src/bytecode.c
index bfbb3b847e..b142e3e667 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 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -39,6 +40,11 @@ by Hallvard:
 #include "charset.h"
 #include "syntax.h"
 
+#ifdef CHECK_FRAME_FONT
+#include "frame.h"
+#include "xterm.h"
+#endif
+
 /*
  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
  * debugging the byte compiler...)
@@ -272,6 +278,13 @@ mark_byte_stack ()
 
   for (stack = byte_stack_list; stack; stack = stack->next)
     {
+      /* If STACK->top is null here, this means there's an opcode in
+	 Fbyte_code that wasn't expected to GC, but did.  To find out
+	 which opcode this is, record the value of `stack', and walk
+	 up the stack in a debugger, stopping in frames of Fbyte_code.
+	 The culprit is found in the frame of Fbyte_code where the
+	 address of its local variable `stack' is equal to the
+	 recorded value of `stack' here.  */
       if (!stack->top)
 	abort ();
       
@@ -384,6 +397,19 @@ 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\
@@ -411,6 +437,16 @@ If the third argument is incorrect, Emacs may crash.")
   Lisp_Object *top;
   Lisp_Object result;
 
+#ifdef CHECK_FRAME_FONT
+ {
+   struct frame *f = SELECTED_FRAME ();
+   if (FRAME_X_P (f)
+       && FRAME_FONT (f)->direction != 0
+       && FRAME_FONT (f)->direction != 1)
+     abort ();
+ }
+#endif
+
   CHECK_STRING (bytestr, 0);
   if (!VECTORP (vector))
     vector = wrong_type_argument (Qvectorp, vector);
@@ -507,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;
 	    }
@@ -637,7 +673,10 @@ If the third argument is incorrect, Emacs may crash.")
 	case Bvarbind+5:
 	  op -= Bvarbind;
 	varbind:
+	  /* Specbind can signal and thus GC.  */
+	  BEFORE_POTENTIAL_GC ();
 	  specbind (vectorp[op], POP);
+	  AFTER_POTENTIAL_GC ();
 	  break;
 
 	case Bcall+6:
@@ -710,7 +749,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;
@@ -721,7 +760,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;
 	    }
@@ -732,7 +771,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;
 	    }
@@ -744,7 +783,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;
 	    }
@@ -753,7 +792,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;
 
@@ -761,7 +800,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++;
@@ -771,7 +810,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++;
@@ -782,7 +821,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);
@@ -793,7 +832,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);
@@ -843,7 +882,10 @@ If the third argument is incorrect, Emacs may crash.")
 	  }
 
 	case Bunwind_protect:
+	  /* The function record_unwind_protect can GC.  */
+	  BEFORE_POTENTIAL_GC ();
 	  record_unwind_protect (0, POP);
+	  AFTER_POTENTIAL_GC ();
 	  (specpdl_ptr - 1)->symbol = Qnil;
 	  break;
 
@@ -860,6 +902,7 @@ If the third argument is incorrect, Emacs may crash.")
 
 	case Btemp_output_buffer_setup:
 	  BEFORE_POTENTIAL_GC ();
+	  CHECK_STRING (TOP, 0);
 	  temp_output_buffer_setup (XSTRING (TOP)->data);
 	  AFTER_POTENTIAL_GC ();
 	  TOP = Vstandard_output;
@@ -1165,8 +1208,10 @@ If the third argument is incorrect, Emacs may crash.")
 	case Bgeq:
 	  {
 	    Lisp_Object v1;
+	    BEFORE_POTENTIAL_GC ();
 	    v1 = POP;
 	    TOP = Fgeq (TOP, v1);
+	    AFTER_POTENTIAL_GC ();
 	    break;
 	  }
 
@@ -1313,7 +1358,9 @@ If the third argument is incorrect, Emacs may crash.")
 	case Bcurrent_column:
 	  {
 	    Lisp_Object v1;
+	    BEFORE_POTENTIAL_GC ();
 	    XSETFASTINT (v1, current_column ());
+	    AFTER_POTENTIAL_GC ();
 	    PUSH (v1);
 	    break;
 	  }