# HG changeset patch # User Jim Blandy # Date 713626254 0 # Node ID c1fc76b79275dc5becde3e616a588ead0a6c5870 # Parent cc82116a8f1cea94f16dd515c29e33d43d822861 * bytecode.c (Fbyte_code): When metering the Bcall opcodes, make sure the count on the symbol's `byte-code-meter' property does not overflow. * bytecode.c (syms_of_bytecode): Add a docstring for byte-metering-on. diff -r cc82116a8f1c -r c1fc76b79275 src/bytecode.c --- a/src/bytecode.c Wed Aug 12 12:57:12 1992 +0000 +++ b/src/bytecode.c Wed Aug 12 13:30:54 1992 +0000 @@ -5,7 +5,7 @@ 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 @@ 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 @@ o all conditionals now only do QUIT if they jump. */ - #include "config.h" #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 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_SAFE - -/* Define this to enable generation of a histogram of byte-op usage. - */ -#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_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 @@ -390,7 +405,20 @@ case Bcall+4: case Bcall+5: op -= Bcall; docall: - DISCARD(op); + DISCARD (op); +#ifdef BYTE_CODE_METER + if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol) + { + v1 = TOP; + v2 = Fget (v1, Qbyte_code_meter); + if (XTYPE (v2) == Lisp_Int + && XINT (v2) != ((1<data + op; } - else DISCARD(1); + else DISCARD (1); break; case Bgotoifnonnilelsepop: @@ -457,7 +484,50 @@ 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 +535,7 @@ goto exit; case Bdiscard: - DISCARD(1); + DISCARD (1); break; case Bdup: @@ -600,15 +670,21 @@ 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,20 +728,26 @@ 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) @@ -716,7 +798,7 @@ break; case Bdiff: - DISCARD(1); + DISCARD (1); TOP = Fminus (2, &TOP); break; @@ -732,33 +814,32 @@ 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; @@ -775,6 +856,12 @@ TOP = Finsert (1, &TOP); break; + case BinsertN: + op = FETCH; + DISCARD (op - 1); + TOP = Finsert (op, &TOP); + break; + case Bpoint_max: XFASTINT (v1) = ZV; PUSH (v1); @@ -842,29 +929,24 @@ 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; @@ -880,13 +962,11 @@ 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,27 +974,49 @@ 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; @@ -932,13 +1034,11 @@ 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,13 +1048,11 @@ 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; @@ -975,13 +1073,12 @@ 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: @@ -996,7 +1093,7 @@ 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 +1132,27 @@ #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 }