]> code.delx.au - gnu-emacs/blobdiff - src/bytecode.c
Use arch-tag: syntax that tla can grok
[gnu-emacs] / src / bytecode.c
index bcd303f8d736a99ee3eae6826f2c74e55d9d3c3b..a13ecc19770a0dd5e0604be510ab41a9ee3b9f46 100644 (file)
@@ -1,5 +1,5 @@
 /* Execution of byte code produced by bytecomp.el.
-   Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001
+   Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003
    Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -22,7 +22,7 @@ Boston, MA 02111-1307, USA.
 hacked on by jwz@lucid.com 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  added a new instruction, unbind_all, which I will use for 
+  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
      of args;
@@ -39,6 +39,7 @@ by Hallvard:
 #include "buffer.h"
 #include "charset.h"
 #include "syntax.h"
+#include "window.h"
 
 #ifdef CHECK_FRAME_FONT
 #include "frame.h"
@@ -46,10 +47,10 @@ by Hallvard:
 #endif
 
 /*
- * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
+ * 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 BYTE_CODE_METER to enable generation of a byte-op usage histogram.
  */
 /* #define BYTE_CODE_SAFE */
 /* #define BYTE_CODE_METER */
@@ -239,7 +240,7 @@ struct byte_stack
 {
   /* Program counter.  This points into the byte_string below
      and is relocated when that string is relocated.  */
-  unsigned char *pc;
+  const unsigned char *pc;
 
   /* Top and bottom of stack.  The bottom points to an area of memory
      allocated with alloca in Fbyte_code.  */
@@ -249,7 +250,7 @@ struct byte_stack
      Storing this here protects it from GC because mark_byte_stack
      marks it.  */
   Lisp_Object byte_string;
-  unsigned char *byte_string_start;
+  const unsigned char *byte_string_start;
 
   /* The vector of constants used during byte-code execution.  Storing
      this here protects it from GC because mark_byte_stack marks it.  */
@@ -285,27 +286,13 @@ mark_byte_stack ()
         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 ();
-      
-      for (obj = stack->bottom; obj <= stack->top; ++obj)
-       if (!XMARKBIT (*obj))
-         {
-           mark_object (obj);
-           XMARK (*obj);
-         }
+      eassert (stack->top);
 
-      if (!XMARKBIT (stack->byte_string))
-       {
-          mark_object (&stack->byte_string);
-         XMARK (stack->byte_string);
-       }
+      for (obj = stack->bottom; obj <= stack->top; ++obj)
+       mark_object (*obj);
 
-      if (!XMARKBIT (stack->constants))
-       {
-         mark_object (&stack->constants);
-         XMARK (stack->constants);
-       }
+      mark_object (stack->byte_string);
+      mark_object (stack->constants);
     }
 }
 
@@ -313,24 +300,17 @@ mark_byte_stack ()
 /* Unmark objects in the stacks on byte_stack_list.  Relocate program
    counters.  Called when GC has completed.  */
 
-void 
+void
 unmark_byte_stack ()
 {
   struct byte_stack *stack;
-  Lisp_Object *obj;
 
   for (stack = byte_stack_list; stack; stack = stack->next)
     {
-      for (obj = stack->bottom; obj <= stack->top; ++obj)
-       XUNMARK (*obj);
-
-      XUNMARK (stack->byte_string);
-      XUNMARK (stack->constants);
-
-      if (stack->byte_string_start != XSTRING (stack->byte_string)->data)
+      if (stack->byte_string_start != SDATA (stack->byte_string))
        {
          int offset = stack->pc - stack->byte_string_start;
-         stack->byte_string_start = XSTRING (stack->byte_string)->data;
+         stack->byte_string_start = SDATA (stack->byte_string);
          stack->pc = stack->byte_string_start + offset;
        }
     }
@@ -420,7 +400,7 @@ If the third argument is incorrect, Emacs may crash.  */)
      (bytestr, vector, maxdepth)
      Lisp_Object bytestr, vector, maxdepth;
 {
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
 #ifdef BYTE_CODE_METER
   int this_op = 0;
   int prev_op;
@@ -460,13 +440,13 @@ If the third argument is incorrect, Emacs may crash.  */)
        convert them back to the originally intended unibyte form.  */
     bytestr = Fstring_as_unibyte (bytestr);
 
-  bytestr_length = STRING_BYTES (XSTRING (bytestr));
+  bytestr_length = SBYTES (bytestr);
   vectorp = XVECTOR (vector)->contents;
 
   stack.byte_string = bytestr;
-  stack.pc = stack.byte_string_start = XSTRING (bytestr)->data;
+  stack.pc = stack.byte_string_start = SDATA (bytestr);
   stack.constants = vector;
-  stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth) 
+  stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth)
                                          * sizeof (Lisp_Object));
   top = stack.bottom - 1;
   stack.top = NULL;
@@ -476,7 +456,7 @@ If the third argument is incorrect, Emacs may crash.  */)
 #ifdef BYTE_CODE_SAFE
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 #endif
-  
+
   while (1)
     {
 #ifdef BYTE_CODE_SAFE
@@ -500,11 +480,11 @@ If the third argument is incorrect, Emacs may crash.  */)
          op = FETCH2;
          goto varref;
 
-       case Bvarref: 
-       case Bvarref + 1: 
-       case Bvarref + 2: 
+       case Bvarref:
+       case Bvarref + 1:
+       case Bvarref + 2:
        case Bvarref + 3:
-       case Bvarref + 4: 
+       case Bvarref + 4:
        case Bvarref + 5:
          op = op - Bvarref;
          goto varref;
@@ -619,7 +599,7 @@ If the third argument is incorrect, Emacs may crash.  */)
        varset:
          {
            Lisp_Object sym, val;
-             
+
            sym = vectorp[op];
            val = TOP;
 
@@ -728,7 +708,7 @@ If the third argument is incorrect, Emacs may crash.  */)
          op -= Bunbind;
        dounbind:
          BEFORE_POTENTIAL_GC ();
-         unbind_to (specpdl_ptr - specpdl - op, Qnil);
+         unbind_to (SPECPDL_INDEX () - op, Qnil);
          AFTER_POTENTIAL_GC ();
          break;
 
@@ -877,9 +857,8 @@ 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);
+         record_unwind_protect (Fprogn, POP);
          AFTER_POTENTIAL_GC ();
-         (specpdl_ptr - 1)->symbol = Qnil;
          break;
 
        case Bcondition_case:
@@ -896,7 +875,7 @@ If the third argument is incorrect, Emacs may crash.  */)
        case Btemp_output_buffer_setup:
          BEFORE_POTENTIAL_GC ();
          CHECK_STRING (TOP);
-         temp_output_buffer_setup (XSTRING (TOP)->data);
+         temp_output_buffer_setup (SDATA (TOP));
          AFTER_POTENTIAL_GC ();
          TOP = Vstandard_output;
          break;
@@ -909,7 +888,7 @@ If the third argument is incorrect, Emacs may crash.  */)
            temp_output_buffer_show (TOP);
            TOP = v1;
            /* pop binding of standard-output */
-           unbind_to (specpdl_ptr - specpdl - 1, Qnil);
+           unbind_to (SPECPDL_INDEX () - 1, Qnil);
            AFTER_POTENTIAL_GC ();
            break;
          }
@@ -1125,7 +1104,11 @@ If the third argument is incorrect, Emacs may crash.  */)
                TOP = v1;
              }
            else
-             TOP = Fsub1 (v1);
+             {
+               BEFORE_POTENTIAL_GC ();
+               TOP = Fsub1 (v1);
+               AFTER_POTENTIAL_GC ();
+             }
            break;
          }
 
@@ -1352,7 +1335,7 @@ If the third argument is incorrect, Emacs may crash.  */)
          {
            Lisp_Object v1;
            BEFORE_POTENTIAL_GC ();
-           XSETFASTINT (v1, current_column ());
+           XSETFASTINT (v1, (int) current_column ()); /* iftc */
            AFTER_POTENTIAL_GC ();
            PUSH (v1);
            break;
@@ -1725,13 +1708,13 @@ If the third argument is incorrect, Emacs may crash.  */)
   byte_stack_list = byte_stack_list->next;
 
   /* Binds and unbinds are supposed to be compiled balanced.  */
-  if (specpdl_ptr - specpdl != count)
+  if (SPECPDL_INDEX () != count)
 #ifdef BYTE_CODE_SAFE
     error ("binding stack not balanced (serious byte compiler bug)");
 #else
     abort ();
 #endif
-  
+
   return result;
 }
 
@@ -1752,7 +1735,7 @@ 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,
               doc: /* If non-nil, keep profiling information on byte code usage.
 The variable byte-code-meter indicates how often each byte opcode is used.
@@ -1771,3 +1754,6 @@ integer, it is incremented each time that symbol's function is called.  */);
   }
 #endif
 }
+
+/* arch-tag: b9803b6f-1ed6-4190-8adf-33fd3a9d10e9
+   (do not change this comment) */