X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/36f7ba0a1e3ee4a5ae38e1bea50dbee5d953e992..c7dd82a34d3b058a81d11823a7f730f6607bd43d:/src/bytecode.c diff --git a/src/bytecode.c b/src/bytecode.c index f888a68b7f..39e2ae4a43 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,11 +1,11 @@ /* 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 -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, @@ -17,14 +17,12 @@ 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. -hacked on by jwz 17-jun-91 +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 put back fset, symbol-function, and read-char because I don't - see any reason for them to have been removed; 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 + o made temp_output_buffer_show be called with the right number of args; o made the new bytecodes be called with args in the right order; o added metering support. @@ -34,48 +32,49 @@ by Hallvard: o all conditionals now only do QUIT if they jump. */ - -#include "config.h" +#include #include "lisp.h" #include "buffer.h" #include "syntax.h" -/* Define this to enable some minor sanity checking - (useful for debugging the byte compiler...) - */ -#define BYTE_CODE_SAFE - -/* Define this to enable generation of a histogram of byte-op usage. +/* + * 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 +/* #define BYTE_CODE_SAFE */ +/* #define BYTE_CODE_METER */ #ifdef BYTE_CODE_METER -Lisp_Object Vbyte_code_meter; +Lisp_Object Vbyte_code_meter, Qbyte_code_meter; int byte_metering_on; -# define METER_2(code1,code2) \ +#define METER_2(code1, code2) \ XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ ->contents[(code2)]) -# define METER_1(code) METER_2 (0,(code)) - -# define METER_CODE(last_code, this_code) { \ - if (byte_metering_on) { \ - if (METER_1 (this_code) != ((1< stacke) - error ( - "Stack overflow in byte code (byte compiler bug), pc = %d, depth = %d", + error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", pc - XSTRING (string_saved)->data, stacke - stackp); if (stackp < stack) - error ("Stack underflow in byte code (byte compiler bug), pc = %d", + error ("Byte code stack underflow (byte compiler bug), pc %d", 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; @@ -321,29 +336,13 @@ If the third argument is incorrect, Emacs may crash.") op = op - Bvarref; varref: v1 = vectorp[op]; - if (XTYPE (v1) != Lisp_Symbol) + if (!SYMBOLP (v1)) 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; @@ -390,7 +389,20 @@ If the third argument is incorrect, Emacs may crash.") case Bcall+4: case Bcall+5: op -= Bcall; docall: - DISCARD(op); + DISCARD (op); +#ifdef BYTE_CODE_METER + if (byte_metering_on && SYMBOLP (TOP)) + { + v1 = TOP; + v2 = Fget (v1, Qbyte_code_meter); + if (INTEGERP (v2) + && XINT (v2) != ((1<data + op; @@ -433,7 +444,7 @@ If the third argument is incorrect, Emacs may crash.") case Bgotoifnonnil: op = FETCH2; - if (!NULL (POP)) + if (!NILP (POP)) { QUIT; pc = XSTRING (string_saved)->data + op; @@ -442,22 +453,65 @@ If the third argument is incorrect, Emacs may crash.") case Bgotoifnilelsepop: op = FETCH2; - if (NULL (TOP)) + if (NILP (TOP)) { QUIT; pc = XSTRING (string_saved)->data + op; } - else DISCARD(1); + else DISCARD (1); break; case Bgotoifnonnilelsepop: op = FETCH2; - if (!NULL (TOP)) + if (!NILP (TOP)) { QUIT; pc = XSTRING (string_saved)->data + op; } - else DISCARD(1); + else DISCARD (1); + break; + + case BRgoto: + QUIT; + pc += *pc - 127; + break; + + case BRgotoifnil: + if (NILP (POP)) + { + QUIT; + pc += *pc - 128; + } + pc++; + break; + + case BRgotoifnonnil: + if (!NILP (POP)) + { + QUIT; + pc += *pc - 128; + } + pc++; + break; + + case BRgotoifnilelsepop: + op = *pc++; + if (NILP (TOP)) + { + QUIT; + pc += op - 128; + } + else DISCARD (1); + break; + + case BRgotoifnonnilelsepop: + op = *pc++; + if (!NILP (TOP)) + { + QUIT; + pc += op - 128; + } + else DISCARD (1); break; case Breturn: @@ -465,7 +519,7 @@ If the third argument is incorrect, Emacs may crash.") goto exit; case Bdiscard: - DISCARD(1); + DISCARD (1); break; case Bdup: @@ -512,7 +566,7 @@ If the third argument is incorrect, Emacs may crash.") 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); @@ -529,7 +583,7 @@ If the third argument is incorrect, Emacs may crash.") { if (CONSP (v1)) v1 = XCONS (v1)->cdr; - else if (!NULL (v1)) + else if (!NILP (v1)) { immediate_quit = 0; v1 = wrong_type_argument (Qlistp, v1); @@ -541,7 +595,7 @@ If the third argument is incorrect, Emacs may crash.") goto docar; case Bsymbolp: - TOP = XTYPE (TOP) == Lisp_Symbol ? Qt : Qnil; + TOP = SYMBOLP (TOP) ? Qt : Qnil; break; case Bconsp: @@ -549,11 +603,11 @@ If the third argument is incorrect, Emacs may crash.") break; case Bstringp: - TOP = XTYPE (TOP) == Lisp_String ? Qt : Qnil; + TOP = STRINGP (TOP) ? Qt : Qnil; break; case Blistp: - TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil; + TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; break; case Beq: @@ -567,21 +621,21 @@ If the third argument is incorrect, Emacs may crash.") break; case Bnot: - TOP = NULL (TOP) ? Qt : Qnil; + TOP = NILP (TOP) ? Qt : Qnil; break; case Bcar: v1 = TOP; docar: if (CONSP (v1)) TOP = XCONS (v1)->car; - else if (NULL (v1)) TOP = Qnil; + else if (NILP (v1)) TOP = Qnil; else Fcar (wrong_type_argument (Qlistp, v1)); break; case Bcdr: v1 = TOP; if (CONSP (v1)) TOP = XCONS (v1)->cdr; - else if (NULL (v1)) TOP = Qnil; + else if (NILP (v1)) TOP = Qnil; else Fcdr (wrong_type_argument (Qlistp, v1)); break; @@ -600,15 +654,21 @@ If the third argument is incorrect, Emacs may crash.") break; case Blist3: - DISCARD(2); + DISCARD (2); TOP = Flist (3, &TOP); break; case Blist4: - DISCARD(3); + DISCARD (3); TOP = Flist (4, &TOP); break; + case BlistN: + op = FETCH; + DISCARD (op - 1); + TOP = Flist (op, &TOP); + break; + case Blength: TOP = Flength (TOP); break; @@ -652,23 +712,29 @@ If the third argument is incorrect, Emacs may crash.") break; case Bconcat2: - DISCARD(1); + DISCARD (1); TOP = Fconcat (2, &TOP); break; case Bconcat3: - DISCARD(2); + DISCARD (2); TOP = Fconcat (3, &TOP); break; case Bconcat4: - DISCARD(3); + DISCARD (3); TOP = Fconcat (4, &TOP); break; + case BconcatN: + op = FETCH; + DISCARD (op - 1); + TOP = Fconcat (op, &TOP); + break; + case Bsub1: v1 = TOP; - if (XTYPE (v1) == Lisp_Int) + if (INTEGERP (v1)) { XSETINT (v1, XINT (v1) - 1); TOP = v1; @@ -679,7 +745,7 @@ If the third argument is incorrect, Emacs may crash.") case Badd1: v1 = TOP; - if (XTYPE (v1) == Lisp_Int) + if (INTEGERP (v1)) { XSETINT (v1, XINT (v1) + 1); TOP = v1; @@ -716,13 +782,13 @@ If the third argument is incorrect, Emacs may crash.") break; case Bdiff: - DISCARD(1); + DISCARD (1); TOP = Fminus (2, &TOP); break; case Bnegate: v1 = TOP; - if (XTYPE (v1) == Lisp_Int) + if (INTEGERP (v1)) { XSETINT (v1, - XINT (v1)); TOP = v1; @@ -732,38 +798,37 @@ If the third argument is incorrect, Emacs may crash.") break; case Bplus: - DISCARD(1); + DISCARD (1); TOP = Fplus (2, &TOP); break; case Bmax: - DISCARD(1); + DISCARD (1); TOP = Fmax (2, &TOP); break; case Bmin: - DISCARD(1); + DISCARD (1); TOP = Fmin (2, &TOP); break; case Bmult: - DISCARD(1); + DISCARD (1); TOP = Ftimes (2, &TOP); break; case Bquo: - DISCARD(1); + DISCARD (1); TOP = Fquo (2, &TOP); break; case Brem: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Frem (TOP, v1); break; case Bpoint: - XFASTINT (v1) = point; + XSETFASTINT (v1, point); PUSH (v1); break; @@ -775,13 +840,19 @@ If the third argument is incorrect, Emacs may crash.") TOP = Finsert (1, &TOP); break; + case BinsertN: + op = FETCH; + DISCARD (op - 1); + TOP = Finsert (op, &TOP); + break; + case Bpoint_max: - XFASTINT (v1) = ZV; + XSETFASTINT (v1, ZV); PUSH (v1); break; case Bpoint_min: - XFASTINT (v1) = BEGV; + XSETFASTINT (v1, BEGV); PUSH (v1); break; @@ -790,17 +861,17 @@ If the third argument is incorrect, Emacs may crash.") break; case Bfollowing_char: - XFASTINT (v1) = PT == ZV ? 0 : FETCH_CHAR (point); + v1 = Ffollowing_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: - XFASTINT (v1) = current_column (); + XSETFASTINT (v1, current_column ()); PUSH (v1); break; @@ -842,35 +913,31 @@ If the third argument is incorrect, Emacs may crash.") break; case Bforward_char: - /* This was wrong! --jwz */ TOP = Fforward_char (TOP); break; case Bforward_word: - /* This was wrong! --jwz */ TOP = Fforward_word (TOP); break; case Bskip_chars_forward: - /* This was wrong! --jwz */ v1 = POP; TOP = Fskip_chars_forward (TOP, v1); break; case Bskip_chars_backward: - /* This was wrong! --jwz */ v1 = POP; TOP = Fskip_chars_backward (TOP, v1); break; case Bforward_line: - /* This was wrong! --jwz */ TOP = Fforward_line (TOP); break; 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: @@ -880,13 +947,11 @@ If the third argument is incorrect, Emacs may crash.") case Bdelete_region: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fdelete_region (TOP, v1); break; case Bnarrow_to_region: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fnarrow_to_region (TOP, v1); break; @@ -894,32 +959,54 @@ If the third argument is incorrect, Emacs may crash.") PUSH (Fwiden ()); break; + case Bend_of_line: + TOP = Fend_of_line (TOP); + break; + + case Bset_marker: + v1 = POP; + v2 = POP; + TOP = Fset_marker (TOP, v2, v1); + break; + + case Bmatch_beginning: + TOP = Fmatch_beginning (TOP); + break; + + case Bmatch_end: + TOP = Fmatch_end (TOP); + break; + + case Bupcase: + TOP = Fupcase (TOP); + break; + + case Bdowncase: + TOP = Fdowncase (TOP); + break; + case Bstringeqlsign: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fstring_equal (TOP, v1); break; case Bstringlss: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fstring_lessp (TOP, v1); break; case Bequal: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fequal (TOP, v1); break; case Bnthcdr: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fnthcdr (TOP, v1); break; case Belt: - if (XTYPE (TOP) == Lisp_Cons) + if (CONSP (TOP)) { /* Exchange args and then do nth. */ v2 = POP; @@ -932,13 +1019,11 @@ If the third argument is incorrect, Emacs may crash.") case Bmember: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fmember (TOP, v1); break; case Bassq: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fassq (TOP, v1); break; @@ -948,19 +1033,17 @@ If the third argument is incorrect, Emacs may crash.") case Bsetcar: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fsetcar (TOP, v1); break; case Bsetcdr: v1 = POP; - /* This had args in the wrong order. -- jwz */ TOP = Fsetcdr (TOP, v1); break; case Bcar_safe: v1 = TOP; - if (XTYPE (v1) == Lisp_Cons) + if (CONSP (v1)) TOP = XCONS (v1)->car; else TOP = Qnil; @@ -968,24 +1051,23 @@ If the third argument is incorrect, Emacs may crash.") case Bcdr_safe: v1 = TOP; - if (XTYPE (v1) == Lisp_Cons) + if (CONSP (v1)) TOP = XCONS (v1)->cdr; else TOP = Qnil; break; case Bnconc: - DISCARD(1); + DISCARD (1); TOP = Fnconc (2, &TOP); break; case Bnumberp: - TOP = (XTYPE (TOP) == Lisp_Int || XTYPE (TOP) == Lisp_Float - ? Qt : Qnil); + TOP = (NUMBERP (TOP) ? Qt : Qnil); break; case Bintegerp: - TOP = XTYPE (TOP) == Lisp_Int ? Qt : Qnil; + TOP = INTEGERP (TOP) ? Qt : Qnil; break; #ifdef BYTE_CODE_SAFE @@ -996,7 +1078,7 @@ If the third argument is incorrect, Emacs may crash.") error ("scan-buffer is an obsolete bytecode"); break; case Bmark: - error("mark is an obsolete bytecode"); + error ("mark is an obsolete bytecode"); break; #endif @@ -1035,17 +1117,27 @@ syms_of_bytecode () #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)); - + Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); + Qbyte_code_meter = intern ("byte-code-meter"); + staticpro (&Qbyte_code_meter); { int i = 256; while (i--) - XVECTOR(Vbyte_code_meter)->contents[i] = - Fmake_vector(make_number(256), make_number(0)); + XVECTOR (Vbyte_code_meter)->contents[i] = + Fmake_vector (make_number (256), make_number (0)); } #endif }