X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/67c098ad3cec5a3af8dfa42ac03783024e06d0d6..a3fc8840a3c1586b17c9d211e959571fba365af6:/src/bytecode.c diff --git a/src/bytecode.c b/src/bytecode.c index ec3fe12e55..193630f025 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -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 -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; @@ -129,7 +130,8 @@ Lisp_Object Qbytecode; #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 @@ -146,6 +148,7 @@ Lisp_Object Qbytecode; #define Bbobp 0157 #define Bcurrent_buffer 0160 #define Bset_buffer 0161 +#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ #define Bread_char 0162 /* No longer generated as of v19 */ #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ @@ -249,10 +252,35 @@ Lisp_Object Qbytecode; #define TOP (*stackp) +/* Garbage collect if we have consed enough since the last time. + We do this at every branch, to avoid loops that never GC. */ + +#define MAYBE_GC() \ + if (consing_since_gc > gc_cons_threshold) \ + { \ + Fgarbage_collect (); \ + HANDLE_RELOCATION (); \ + } \ + else + +/* Relocate BYTESTR if there has been a GC recently. */ +#define HANDLE_RELOCATION() \ + if (! EQ (string_saved, bytestr)) \ + { \ + pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data; \ + string_saved = bytestr; \ + } \ + else + +/* Check for jumping out of range. */ +#define CHECK_RANGE(ARG) \ + if (ARG >= bytestr_length) abort () + 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; @@ -278,6 +306,7 @@ If the third argument is incorrect, Emacs may crash.") /* Cached address of beginning of string, valid if BYTESTR equals STRING_SAVED. */ register unsigned char *strbeg; + int bytestr_length = XSTRING (bytestr)->size_byte; CHECK_STRING (bytestr, 0); if (!VECTORP (vector)) @@ -308,11 +337,8 @@ If the third argument is incorrect, Emacs may crash.") pc - XSTRING (string_saved)->data); #endif - if (! EQ (string_saved, bytestr)) - { - pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data; - string_saved = bytestr; - } + /* Update BYTESTR if we had a garbage collection. */ + HANDLE_RELOCATION (); #ifdef BYTE_CODE_METER prev_op = this_op; @@ -428,73 +454,87 @@ If the third argument is incorrect, Emacs may crash.") break; case Bgoto: + MAYBE_GC (); QUIT; op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ + CHECK_RANGE (op); pc = XSTRING (string_saved)->data + op; break; case Bgotoifnil: + MAYBE_GC (); op = FETCH2; if (NILP (POP)) { QUIT; + CHECK_RANGE (op); pc = XSTRING (string_saved)->data + op; } break; case Bgotoifnonnil: + MAYBE_GC (); op = FETCH2; if (!NILP (POP)) { QUIT; + CHECK_RANGE (op); pc = XSTRING (string_saved)->data + op; } break; case Bgotoifnilelsepop: + MAYBE_GC (); op = FETCH2; if (NILP (TOP)) { QUIT; + CHECK_RANGE (op); pc = XSTRING (string_saved)->data + op; } else DISCARD (1); break; case Bgotoifnonnilelsepop: + MAYBE_GC (); op = FETCH2; if (!NILP (TOP)) { QUIT; + CHECK_RANGE (op); pc = XSTRING (string_saved)->data + op; } else DISCARD (1); break; case BRgoto: + MAYBE_GC (); QUIT; - pc += *pc - 127; + pc += (int) *pc - 127; break; case BRgotoifnil: + MAYBE_GC (); if (NILP (POP)) { QUIT; - pc += *pc - 128; + pc += (int) *pc - 128; } pc++; break; case BRgotoifnonnil: + MAYBE_GC (); if (!NILP (POP)) { QUIT; - pc += *pc - 128; + pc += (int) *pc - 128; } pc++; break; case BRgotoifnilelsepop: + MAYBE_GC (); op = *pc++; if (NILP (TOP)) { @@ -505,6 +545,7 @@ If the third argument is incorrect, Emacs may crash.") break; case BRgotoifnonnilelsepop: + MAYBE_GC (); op = *pc++; if (!NILP (TOP)) { @@ -535,6 +576,11 @@ If the third argument is incorrect, Emacs may crash.") record_unwind_protect (save_excursion_restore, save_excursion_save ()); break; + case Bsave_current_buffer: + case Bsave_current_buffer_1: + record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); + break; + case Bsave_window_excursion: TOP = Fsave_window_excursion (TOP); break; @@ -769,7 +815,7 @@ If the third argument is incorrect, Emacs may crash.") } else #endif - TOP = (XINT (num1) == XINT (num2) ? Qt : Qnil); + TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); break; case Bgtr: @@ -839,7 +885,7 @@ If the third argument is incorrect, Emacs may crash.") break; case Bpoint: - XSETFASTINT (v1, point); + XSETFASTINT (v1, PT); PUSH (v1); break; @@ -914,11 +960,6 @@ If the third argument is incorrect, Emacs may crash.") TOP = Fset_buffer (TOP); break; - case Bread_char: - PUSH (Fread_char ()); - QUIT; - break; - case Binteractive_p: PUSH (Finteractive_p ()); break;