(set_properties, add_properties, remove_properties):

[gnu-emacs] / src / bytecode.c

diff --git a/src/bytecode.c b/src/bytecode.c
index acde450299caace26af63086f42408589052b758..ae290c273526953e395b9f11f6f82b22d66029c5 100644 (file)
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1,11 +1,11 @@
 /* Execution of byte code produced by bytecomp.el.
 /* Execution of byte code produced by bytecomp.el.

-   Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1993 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
 
 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 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)

 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,


@@ -15,7 +15,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 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.
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+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;
 
 hacked on by jwz@lucid.com 17-jun-91
   o  added a compile-time switch to turn on simple sanity checking;


@@ -32,7 +33,7 @@ by Hallvard:
   o  all conditionals now only do QUIT if they jump.
  */
 
   o  all conditionals now only do QUIT if they jump.
  */
 

-#include "config.h"
+#include <config.h>

 #include "lisp.h"
 #include "buffer.h"
 #include "syntax.h"
 #include "lisp.h"
 #include "buffer.h"
 #include "syntax.h"


@@ -65,7 +66,7 @@ int byte_metering_on;
       if (METER_1 (this_code) != ((1<<VALBITS)-1))             \
         METER_1 (this_code)++;                                 \
       if (last_code                                            \
       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) != ((1<<VALBITS)-1))\

         METER_2 (last_code, this_code)++;                      \
     }                                                          \
 }
         METER_2 (last_code, this_code)++;                      \
     }                                                          \
 }


@@ -106,9 +107,9 @@ Lisp_Object Qbytecode;
 #define Baref 0110
 #define Baset 0111
 #define Bsymbol_value 0112
 #define Baref 0110
 #define Baset 0111
 #define Bsymbol_value 0112

-#define Bsymbol_function 0113 /* no longer generated as of v19 */
+#define Bsymbol_function 0113

 #define Bset 0114
 #define Bset 0114

-#define Bfset 0115 /* no longer generated as of v19 */
+#define Bfset 0115

 #define Bget 0116
 #define Bsubstring 0117
 #define Bconcat2 0120
 #define Bget 0116
 #define Bsubstring 0117
 #define Bconcat2 0120


@@ -129,7 +130,8 @@ Lisp_Object Qbytecode;
 #define Bmult 0137
 
 #define Bpoint 0140
 #define Bmult 0137
 
 #define Bpoint 0140

-#define Bmark 0141 /* no longer generated as of v18 */
+/* Was Bmark in v17.  */
+#define Bsave_current_buffer 0141

 #define Bgoto_char 0142
 #define Binsert 0143
 #define Bpoint_max 0144
 #define Bgoto_char 0142
 #define Binsert 0143
 #define Bpoint_max 0144


@@ -251,8 +253,9 @@ Lisp_Object Qbytecode;
 
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
   "Function used internally in byte-compiled code.\n\
 
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
   "Function used internally in byte-compiled code.\n\

-The first argument is a string of byte code; the second, a vector of constants;\n\
-the third, the maximum stack depth used in this function.\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)
      Lisp_Object bytestr, vector, maxdepth;
 If the third argument is incorrect, Emacs may crash.")
   (bytestr, vector, maxdepth)
      Lisp_Object bytestr, vector, maxdepth;


@@ -280,7 +283,7 @@ If the third argument is incorrect, Emacs may crash.")
   register unsigned char *strbeg;
 
   CHECK_STRING (bytestr, 0);
   register unsigned char *strbeg;
 
   CHECK_STRING (bytestr, 0);

-  if (XTYPE (vector) != Lisp_Vector)
+  if (!VECTORP (vector))

     vector = wrong_type_argument (Qvectorp, vector);
   CHECK_NUMBER (maxdepth, 2);
 
     vector = wrong_type_argument (Qvectorp, vector);
   CHECK_NUMBER (maxdepth, 2);
 


@@ -308,7 +311,7 @@ If the third argument is incorrect, Emacs may crash.")
               pc - XSTRING (string_saved)->data);
 #endif
 
               pc - XSTRING (string_saved)->data);
 #endif
 

-      if (string_saved != bytestr)
+      if (! EQ (string_saved, bytestr))

        {
          pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data;
          string_saved = bytestr;
        {
          pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data;
          string_saved = bytestr;


@@ -336,29 +339,13 @@ If the third argument is incorrect, Emacs may crash.")
          op = op - Bvarref;
        varref:
          v1 = vectorp[op];
          op = op - Bvarref;
        varref:
          v1 = vectorp[op];

-         if (XTYPE (v1) != Lisp_Symbol)
+         if (!SYMBOLP (v1))

            v2 = Fsymbol_value (v1);
          else
            {
              v2 = XSYMBOL (v1)->value;
            v2 = Fsymbol_value (v1);
          else
            {
              v2 = XSYMBOL (v1)->value;

-#ifdef SWITCH_ENUM_BUG
-             switch ((int) XTYPE (v2))
-#else
-             switch (XTYPE (v2))
-#endif
-               {
-               case Lisp_Symbol:
-                 if (!EQ (v2, Qunbound))
-                   break;
-               case Lisp_Intfwd:
-               case Lisp_Boolfwd:
-               case Lisp_Objfwd:
-               case Lisp_Buffer_Local_Value:
-               case Lisp_Some_Buffer_Local_Value:
-               case Lisp_Buffer_Objfwd:
-               case Lisp_Void:
-                 v2 = Fsymbol_value (v1);
-               }
+             if (MISCP (v2) || EQ (v2, Qunbound))
+               v2 = Fsymbol_value (v1);

            }
          PUSH (v2);
          break;
            }
          PUSH (v2);
          break;


@@ -407,11 +394,12 @@ If the third argument is incorrect, Emacs may crash.")
        docall:
          DISCARD (op);
 #ifdef BYTE_CODE_METER
        docall:
          DISCARD (op);
 #ifdef BYTE_CODE_METER

-         if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
+         if (byte_metering_on && SYMBOLP (TOP))

            {
              v1 = TOP;
              v2 = Fget (v1, Qbyte_code_meter);
            {
              v1 = TOP;
              v2 = Fget (v1, Qbyte_code_meter);

-             if (XTYPE (v2) == Lisp_Int)
+             if (INTEGERP (v2)
+                 && XINT (v2) != ((1<<VALBITS)-1))

                {
                  XSETINT (v2, XINT (v2) + 1);
                  Fput (v1, Qbyte_code_meter, v2);
                {
                  XSETINT (v2, XINT (v2) + 1);
                  Fput (v1, Qbyte_code_meter, v2);


@@ -488,14 +476,14 @@ If the third argument is incorrect, Emacs may crash.")
 
        case BRgoto:
          QUIT;
 
        case BRgoto:
          QUIT;

-         pc += *pc - 127;
+         pc += (int) *pc - 127;

          break;
 
        case BRgotoifnil:
          if (NILP (POP))
            {
              QUIT;
          break;
 
        case BRgotoifnil:
          if (NILP (POP))
            {
              QUIT;

-             pc += *pc - 128;
+             pc += (int) *pc - 128;

            }
          pc++;
          break;
            }
          pc++;
          break;


@@ -504,7 +492,7 @@ If the third argument is incorrect, Emacs may crash.")
          if (!NILP (POP))
            {
              QUIT;
          if (!NILP (POP))
            {
              QUIT;

-             pc += *pc - 128;
+             pc += (int) *pc - 128;

            }
          pc++;
          break;
            }
          pc++;
          break;


@@ -550,6 +538,10 @@ If the third argument is incorrect, Emacs may crash.")
          record_unwind_protect (save_excursion_restore, save_excursion_save ());
          break;
 
          record_unwind_protect (save_excursion_restore, save_excursion_save ());
          break;
 

+       case Bsave_current_buffer:
+         record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+         break;
+

        case Bsave_window_excursion:
          TOP = Fsave_window_excursion (TOP);
          break;
        case Bsave_window_excursion:
          TOP = Fsave_window_excursion (TOP);
          break;


@@ -581,7 +573,7 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Btemp_output_buffer_show:
          v1 = POP;
 
        case Btemp_output_buffer_show:
          v1 = POP;

-         temp_output_buffer_show (TOP, Qnil);
+         temp_output_buffer_show (TOP);

          TOP = v1;
          /* pop binding of standard-output */
          unbind_to (specpdl_ptr - specpdl - 1, Qnil);
          TOP = v1;
          /* pop binding of standard-output */
          unbind_to (specpdl_ptr - specpdl - 1, Qnil);


@@ -610,7 +602,7 @@ If the third argument is incorrect, Emacs may crash.")
          goto docar;
 
        case Bsymbolp:
          goto docar;
 
        case Bsymbolp:

-         TOP = XTYPE (TOP) == Lisp_Symbol ? Qt : Qnil;
+         TOP = SYMBOLP (TOP) ? Qt : Qnil;

          break;
 
        case Bconsp:
          break;
 
        case Bconsp:


@@ -618,7 +610,7 @@ If the third argument is incorrect, Emacs may crash.")
          break;
 
        case Bstringp:
          break;
 
        case Bstringp:

-         TOP = XTYPE (TOP) == Lisp_String ? Qt : Qnil;
+         TOP = STRINGP (TOP) ? Qt : Qnil;

          break;
 
        case Blistp:
          break;
 
        case Blistp:


@@ -749,7 +741,7 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Bsub1:
          v1 = TOP;
 
        case Bsub1:
          v1 = TOP;

-         if (XTYPE (v1) == Lisp_Int)
+         if (INTEGERP (v1))

            {
              XSETINT (v1, XINT (v1) - 1);
              TOP = v1;
            {
              XSETINT (v1, XINT (v1) - 1);
              TOP = v1;


@@ -760,7 +752,7 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Badd1:
          v1 = TOP;
 
        case Badd1:
          v1 = TOP;

-         if (XTYPE (v1) == Lisp_Int)
+         if (INTEGERP (v1))

            {
              XSETINT (v1, XINT (v1) + 1);
              TOP = v1;
            {
              XSETINT (v1, XINT (v1) + 1);
              TOP = v1;


@@ -773,7 +765,18 @@ If the third argument is incorrect, Emacs may crash.")
          v2 = POP; v1 = TOP;
          CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
          CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
          v2 = POP; v1 = TOP;
          CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
          CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);

-         TOP = (XFLOATINT (v1) == XFLOATINT (v2)) ? Qt : Qnil;
+#ifdef LISP_FLOAT_TYPE
+         if (FLOATP (v1) || FLOATP (v2))
+           {
+             double f1, f2;
+
+             f1 = (FLOATP (v1) ? XFLOAT (v1)->data : XINT (v1));
+             f2 = (FLOATP (v2) ? XFLOAT (v2)->data : XINT (v2));
+             TOP = (f1 == f2 ? Qt : Qnil);
+           }
+         else
+#endif
+           TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);

          break;
 
        case Bgtr:
          break;
 
        case Bgtr:


@@ -803,7 +806,7 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Bnegate:
          v1 = TOP;
 
        case Bnegate:
          v1 = TOP;

-         if (XTYPE (v1) == Lisp_Int)
+         if (INTEGERP (v1))

            {
              XSETINT (v1, - XINT (v1));
              TOP = v1;
            {
              XSETINT (v1, - XINT (v1));
              TOP = v1;


@@ -843,7 +846,7 @@ If the third argument is incorrect, Emacs may crash.")
          break;
 
        case Bpoint:
          break;
 
        case Bpoint:

-         XFASTINT (v1) = point;
+         XSETFASTINT (v1, PT);

          PUSH (v1);
          break;
 
          PUSH (v1);
          break;
 


@@ -862,12 +865,12 @@ If the third argument is incorrect, Emacs may crash.")
          break;
 
        case Bpoint_max:
          break;
 
        case Bpoint_max:

-         XFASTINT (v1) = ZV;
+         XSETFASTINT (v1, ZV);

          PUSH (v1);
          break;
 
        case Bpoint_min:
          PUSH (v1);
          break;
 
        case Bpoint_min:

-         XFASTINT (v1) = BEGV;
+         XSETFASTINT (v1, BEGV);

          PUSH (v1);
          break;
 
          PUSH (v1);
          break;
 


@@ -876,17 +879,17 @@ If the third argument is incorrect, Emacs may crash.")
          break;
 
        case Bfollowing_char:
          break;
 
        case Bfollowing_char:

-         XFASTINT (v1) = PT == ZV ? 0 : FETCH_CHAR (point);
+         v1 = Ffollowing_char ();

          PUSH (v1);
          break;
 
        case Bpreceding_char:
          PUSH (v1);
          break;
 
        case Bpreceding_char:

-         XFASTINT (v1) = point <= BEGV ? 0 : FETCH_CHAR (point - 1);
+         v1 = Fprevious_char ();

          PUSH (v1);
          break;
 
        case Bcurrent_column:
          PUSH (v1);
          break;
 
        case Bcurrent_column:

-         XFASTINT (v1) = current_column ();
+         XSETFASTINT (v1, current_column ());

          PUSH (v1);
          break;
 
          PUSH (v1);
          break;
 


@@ -951,7 +954,8 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Bchar_syntax:
          CHECK_NUMBER (TOP, 0);
 
        case Bchar_syntax:
          CHECK_NUMBER (TOP, 0);

-         XFASTINT (TOP) = syntax_code_spec[(int) SYNTAX (0xFF & XINT (TOP))];
+         XSETFASTINT (TOP,
+                      syntax_code_spec[(int) SYNTAX (XINT (TOP))]);

          break;
 
        case Bbuffer_substring:
          break;
 
        case Bbuffer_substring:


@@ -1020,7 +1024,7 @@ If the third argument is incorrect, Emacs may crash.")
          break;
 
        case Belt:
          break;
 
        case Belt:

-         if (XTYPE (TOP) == Lisp_Cons)
+         if (CONSP (TOP))

            {
              /* Exchange args and then do nth.  */
              v2 = POP;
            {
              /* Exchange args and then do nth.  */
              v2 = POP;


@@ -1057,7 +1061,7 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Bcar_safe:
          v1 = TOP;
 
        case Bcar_safe:
          v1 = TOP;

-         if (XTYPE (v1) == Lisp_Cons)
+         if (CONSP (v1))

            TOP = XCONS (v1)->car;
          else
            TOP = Qnil;
            TOP = XCONS (v1)->car;
          else
            TOP = Qnil;


@@ -1065,7 +1069,7 @@ If the third argument is incorrect, Emacs may crash.")
 
        case Bcdr_safe:
          v1 = TOP;
 
        case Bcdr_safe:
          v1 = TOP;

-         if (XTYPE (v1) == Lisp_Cons)
+         if (CONSP (v1))

            TOP = XCONS (v1)->cdr;
          else
            TOP = Qnil;
            TOP = XCONS (v1)->cdr;
          else
            TOP = Qnil;


@@ -1077,12 +1081,11 @@ If the third argument is incorrect, Emacs may crash.")
          break;
 
        case Bnumberp:
          break;
 
        case Bnumberp:

-         TOP = (XTYPE (TOP) == Lisp_Int || XTYPE (TOP) == Lisp_Float
-                ? Qt : Qnil);
+         TOP = (NUMBERP (TOP) ? Qt : Qnil);

          break;
 
        case Bintegerp:
          break;
 
        case Bintegerp:

-         TOP = XTYPE (TOP) == Lisp_Int ? Qt : Qnil;
+         TOP = INTEGERP (TOP) ? Qt : Qnil;

          break;
 
 #ifdef BYTE_CODE_SAFE
          break;
 
 #ifdef BYTE_CODE_SAFE


@@ -1132,8 +1135,17 @@ syms_of_bytecode ()
 #ifdef BYTE_CODE_METER
 
   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
 #ifdef BYTE_CODE_METER
 
   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,

-   "A vector of vectors which holds a histogram of byte-code usage.");
-  DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, "");
+   "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.");
+  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.");

 
   byte_metering_on = 0;
   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
 
   byte_metering_on = 0;
   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));