X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/36f7ba0a1e3ee4a5ae38e1bea50dbee5d953e992..ddf768c3cf57a412f525b53aa30f014db963deec:/src/bytecode.c diff --git a/src/bytecode.c b/src/bytecode.c index f888a68b7f..9987c6118b 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 "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; @@ -390,7 +405,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 && XTYPE (TOP) == Lisp_Symbol) + { + v1 = TOP; + v2 = Fget (v1, Qbyte_code_meter); + if (XTYPE (v2) == Lisp_Int + && XINT (v2) != ((1<data + op; @@ -433,7 +460,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 +469,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 +535,7 @@ If the third argument is incorrect, Emacs may crash.") goto exit; case Bdiscard: - DISCARD(1); + DISCARD (1); break; case Bdup: @@ -512,7 +582,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 +599,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); @@ -553,7 +623,7 @@ If the third argument is incorrect, Emacs may crash.") break; case Blistp: - TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil; + TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; break; case Beq: @@ -567,21 +637,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 +670,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,20 +728,26 @@ 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) @@ -716,7 +798,7 @@ If the third argument is incorrect, Emacs may crash.") break; case Bdiff: - DISCARD(1); + DISCARD (1); TOP = Fminus (2, &TOP); break; @@ -732,33 +814,32 @@ 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; @@ -775,6 +856,12 @@ 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; PUSH (v1); @@ -842,29 +929,24 @@ 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; @@ -880,13 +962,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,27 +974,49 @@ 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; @@ -932,13 +1034,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,13 +1048,11 @@ 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; @@ -975,13 +1073,12 @@ If the third argument is incorrect, Emacs may crash.") 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 @@ 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 +1132,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 }