X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cc94f3b24e447e04da3e899af8909cb77d648ef0..d4881c6acbb41cfd507b533efdd2cdaaf5eac204:/src/bytecode.c diff --git a/src/bytecode.c b/src/bytecode.c index 14a93f18f8..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\ @@ -401,21 +427,42 @@ If the third argument is incorrect, Emacs may crash.") #endif int op; /* Lisp_Object v1, v2; */ - Lisp_Object *vectorp = XVECTOR (vector)->contents; + Lisp_Object *vectorp; #ifdef BYTE_CODE_SAFE int const_length = XVECTOR (vector)->size; Lisp_Object *stacke; #endif - int bytestr_length = STRING_BYTES (XSTRING (bytestr)); + int bytestr_length; struct byte_stack stack; 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); CHECK_NUMBER (maxdepth, 2); + 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. */ + bytestr = Fstring_as_unibyte (bytestr); + + bytestr_length = STRING_BYTES (XSTRING (bytestr)); + vectorp = XVECTOR (vector)->contents; + stack.byte_string = bytestr; stack.pc = stack.byte_string_start = XSTRING (bytestr)->data; stack.constants = vector; @@ -475,10 +522,18 @@ If the third argument is incorrect, Emacs may crash.") { v2 = XSYMBOL (v1)->value; if (MISCP (v2) || EQ (v2, Qunbound)) - v2 = Fsymbol_value (v1); + { + BEFORE_POTENTIAL_GC (); + v2 = Fsymbol_value (v1); + AFTER_POTENTIAL_GC (); + } } else - v2 = Fsymbol_value (v1); + { + BEFORE_POTENTIAL_GC (); + v2 = Fsymbol_value (v1); + AFTER_POTENTIAL_GC (); + } PUSH (v2); break; } @@ -488,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; } @@ -522,8 +577,10 @@ If the third argument is incorrect, Emacs may crash.") case Bmemq: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fmemq (TOP, v1); + AFTER_POTENTIAL_GC (); break; } @@ -544,20 +601,50 @@ If the third argument is incorrect, Emacs may crash.") break; } - case Bvarset+7: - op = FETCH2; + case Bvarset: + case Bvarset+1: + case Bvarset+2: + case Bvarset+3: + case Bvarset+4: + case Bvarset+5: + op -= Bvarset; goto varset; - case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3: - case Bvarset+4: case Bvarset+5: - op -= Bvarset; + case Bvarset+7: + op = FETCH2; goto varset; case Bvarset+6: op = FETCH; varset: - set_internal (vectorp[op], POP, current_buffer, 0); - /* Fset (vectorp[op], POP); */ + { + Lisp_Object sym, val; + + sym = vectorp[op]; + val = TOP; + + /* 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)->value = val; + else + { + BEFORE_POTENTIAL_GC (); + set_internal (sym, val, current_buffer, 0); + AFTER_POTENTIAL_GC (); + } + } + POP; break; case Bdup: @@ -586,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: @@ -659,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; @@ -670,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; } @@ -681,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; } @@ -693,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; } @@ -702,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; @@ -710,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++; @@ -720,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++; @@ -731,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); @@ -742,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); @@ -784,15 +874,18 @@ If the third argument is incorrect, Emacs may crash.") case Bcatch: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; TOP = internal_catch (TOP, Feval, v1); AFTER_POTENTIAL_GC (); break; } 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; @@ -809,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; @@ -817,8 +911,8 @@ If the third argument is incorrect, Emacs may crash.") case Btemp_output_buffer_show: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; temp_output_buffer_show (TOP); TOP = v1; /* pop binding of standard-output */ @@ -830,9 +924,9 @@ If the third argument is incorrect, Emacs may crash.") case Bnth: { Lisp_Object v1, v2; + BEFORE_POTENTIAL_GC (); v1 = POP; v2 = TOP; - BEFORE_POTENTIAL_GC (); CHECK_NUMBER (v2, 0); AFTER_POTENTIAL_GC (); op = XINT (v2); @@ -922,86 +1016,110 @@ If the third argument is incorrect, Emacs may crash.") break; case Blength: + BEFORE_POTENTIAL_GC (); TOP = Flength (TOP); + AFTER_POTENTIAL_GC (); break; case Baref: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Faref (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Baset: { Lisp_Object v1, v2; + BEFORE_POTENTIAL_GC (); v2 = POP; v1 = POP; TOP = Faset (TOP, v1, v2); + AFTER_POTENTIAL_GC (); break; } case Bsymbol_value: + BEFORE_POTENTIAL_GC (); TOP = Fsymbol_value (TOP); + AFTER_POTENTIAL_GC (); break; case Bsymbol_function: + BEFORE_POTENTIAL_GC (); TOP = Fsymbol_function (TOP); + AFTER_POTENTIAL_GC (); break; case Bset: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fset (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bfset: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Ffset (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bget: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fget (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bsubstring: { Lisp_Object v1, v2; - v2 = POP; v1 = POP; BEFORE_POTENTIAL_GC (); + v2 = POP; v1 = POP; TOP = Fsubstring (TOP, v1, v2); AFTER_POTENTIAL_GC (); break; } case Bconcat2: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fconcat (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bconcat3: + BEFORE_POTENTIAL_GC (); DISCARD (2); TOP = Fconcat (3, &TOP); + AFTER_POTENTIAL_GC (); break; case Bconcat4: + BEFORE_POTENTIAL_GC (); DISCARD (3); TOP = Fconcat (4, &TOP); + AFTER_POTENTIAL_GC (); break; case BconcatN: op = FETCH; + BEFORE_POTENTIAL_GC (); DISCARD (op - 1); TOP = Fconcat (op, &TOP); + AFTER_POTENTIAL_GC (); break; case Bsub1: @@ -1028,15 +1146,19 @@ If the third argument is incorrect, Emacs may crash.") TOP = v1; } else - TOP = Fadd1 (v1); + { + BEFORE_POTENTIAL_GC (); + TOP = Fadd1 (v1); + AFTER_POTENTIAL_GC (); + } break; } case Beqlsign: { Lisp_Object v1, v2; - v2 = POP; v1 = TOP; BEFORE_POTENTIAL_GC (); + v2 = POP; v1 = TOP; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0); AFTER_POTENTIAL_GC (); @@ -1056,38 +1178,48 @@ If the third argument is incorrect, Emacs may crash.") case Bgtr: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fgtr (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Blss: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Flss (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bleq: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fleq (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bgeq: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fgeq (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bdiff: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fminus (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bnegate: @@ -1100,40 +1232,56 @@ If the third argument is incorrect, Emacs may crash.") TOP = v1; } else - TOP = Fminus (1, &TOP); + { + BEFORE_POTENTIAL_GC (); + TOP = Fminus (1, &TOP); + AFTER_POTENTIAL_GC (); + } break; } case Bplus: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fplus (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bmax: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fmax (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bmin: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fmin (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bmult: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Ftimes (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bquo: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fquo (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Brem: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Frem (TOP, v1); + AFTER_POTENTIAL_GC (); break; } @@ -1182,13 +1330,17 @@ If the third argument is incorrect, Emacs may crash.") } case Bchar_after: + BEFORE_POTENTIAL_GC (); TOP = Fchar_after (TOP); + AFTER_POTENTIAL_GC (); break; case Bfollowing_char: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = Ffollowing_char (); + AFTER_POTENTIAL_GC (); PUSH (v1); break; } @@ -1196,7 +1348,9 @@ If the third argument is incorrect, Emacs may crash.") case Bpreceding_char: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = Fprevious_char (); + AFTER_POTENTIAL_GC (); PUSH (v1); break; } @@ -1204,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; } @@ -1260,8 +1416,8 @@ If the third argument is incorrect, Emacs may crash.") case Bskip_chars_forward: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; TOP = Fskip_chars_forward (TOP, v1); AFTER_POTENTIAL_GC (); break; @@ -1270,8 +1426,8 @@ If the third argument is incorrect, Emacs may crash.") case Bskip_chars_backward: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; TOP = Fskip_chars_backward (TOP, v1); AFTER_POTENTIAL_GC (); break; @@ -1293,8 +1449,8 @@ If the third argument is incorrect, Emacs may crash.") case Bbuffer_substring: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; TOP = Fbuffer_substring (TOP, v1); AFTER_POTENTIAL_GC (); break; @@ -1303,8 +1459,8 @@ If the third argument is incorrect, Emacs may crash.") case Bdelete_region: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; TOP = Fdelete_region (TOP, v1); AFTER_POTENTIAL_GC (); break; @@ -1313,8 +1469,8 @@ If the third argument is incorrect, Emacs may crash.") case Bnarrow_to_region: { Lisp_Object v1; - v1 = POP; BEFORE_POTENTIAL_GC (); + v1 = POP; TOP = Fnarrow_to_region (TOP, v1); AFTER_POTENTIAL_GC (); break; @@ -1335,41 +1491,55 @@ If the third argument is incorrect, Emacs may crash.") case Bset_marker: { Lisp_Object v1, v2; + BEFORE_POTENTIAL_GC (); v1 = POP; v2 = POP; TOP = Fset_marker (TOP, v2, v1); + AFTER_POTENTIAL_GC (); break; } case Bmatch_beginning: + BEFORE_POTENTIAL_GC (); TOP = Fmatch_beginning (TOP); + AFTER_POTENTIAL_GC (); break; case Bmatch_end: + BEFORE_POTENTIAL_GC (); TOP = Fmatch_end (TOP); + AFTER_POTENTIAL_GC (); break; case Bupcase: + BEFORE_POTENTIAL_GC (); TOP = Fupcase (TOP); + AFTER_POTENTIAL_GC (); break; case Bdowncase: + BEFORE_POTENTIAL_GC (); TOP = Fdowncase (TOP); + AFTER_POTENTIAL_GC (); break; case Bstringeqlsign: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fstring_equal (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bstringlss: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fstring_lessp (TOP, v1); + AFTER_POTENTIAL_GC (); break; } @@ -1384,8 +1554,10 @@ If the third argument is incorrect, Emacs may crash.") case Bnthcdr: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fnthcdr (TOP, v1); + AFTER_POTENTIAL_GC (); break; } @@ -1395,9 +1567,9 @@ If the third argument is incorrect, Emacs may crash.") if (CONSP (TOP)) { /* Exchange args and then do nth. */ + BEFORE_POTENTIAL_GC (); v2 = POP; v1 = TOP; - BEFORE_POTENTIAL_GC (); CHECK_NUMBER (v2, 0); AFTER_POTENTIAL_GC (); op = XINT (v2); @@ -1430,8 +1602,10 @@ If the third argument is incorrect, Emacs may crash.") } else { + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Felt (TOP, v1); + AFTER_POTENTIAL_GC (); } break; } @@ -1439,36 +1613,46 @@ If the third argument is incorrect, Emacs may crash.") case Bmember: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fmember (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bassq: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fassq (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bnreverse: + BEFORE_POTENTIAL_GC (); TOP = Fnreverse (TOP); + AFTER_POTENTIAL_GC (); break; case Bsetcar: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fsetcar (TOP, v1); + AFTER_POTENTIAL_GC (); break; } case Bsetcdr: { Lisp_Object v1; + BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fsetcdr (TOP, v1); + AFTER_POTENTIAL_GC (); break; } @@ -1495,8 +1679,10 @@ If the third argument is incorrect, Emacs may crash.") } case Bnconc: + BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fnconc (2, &TOP); + AFTER_POTENTIAL_GC (); break; case Bnumberp: