Mercurial > hg > xemacs-beta
changeset 4921:17362f371cc2
add more byte-code assertions and better failure output
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-03 Ben Wing <ben@xemacs.org>
* alloc.c (Fmake_byte_code):
* bytecode.h:
* lisp.h:
* lread.c:
* lread.c (readevalloop):
* lread.c (Fread):
* lread.c (Fread_from_string):
* lread.c (read_list_conser):
* lread.c (read_list):
* lread.c (vars_of_lread):
* symbols.c:
* symbols.c (Fdefine_function):
Turn on the "compiled-function annotation hack". Implement it
properly by hooking into Fdefalias(). Note in the docstring to
`defalias' that we do this. Remove some old broken code and
change code that implemented the old kludgy way of hooking into
the Lisp reader into bracketed by `#ifdef
COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY', which is not enabled.
Also enable byte-code metering when DEBUG_XEMACS -- this is a form
of profiling for computing histograms of which sequences of two
bytecodes are used most often.
* bytecode-ops.h:
* bytecode-ops.h (OPCODE):
New file. Extract out all the opcodes and declare them using
OPCODE(), a bit like frame slots and such. This way the file can
be included multiple times if necessary to iterate multiple times
over the byte opcodes.
* bytecode.c:
* bytecode.c (NUM_REMEMBERED_BYTE_OPS):
* bytecode.c (OPCODE):
* bytecode.c (assert_failed_with_remembered_ops):
* bytecode.c (READ_UINT_2):
* bytecode.c (READ_INT_1):
* bytecode.c (READ_INT_2):
* bytecode.c (PEEK_INT_1):
* bytecode.c (PEEK_INT_2):
* bytecode.c (JUMP_RELATIVE):
* bytecode.c (JUMP_NEXT):
* bytecode.c (PUSH):
* bytecode.c (POP_WITH_MULTIPLE_VALUES):
* bytecode.c (DISCARD):
* bytecode.c (UNUSED):
* bytecode.c (optimize_byte_code):
* bytecode.c (optimize_compiled_function):
* bytecode.c (Fbyte_code):
* bytecode.c (vars_of_bytecode):
* bytecode.c (init_opcode_table_multi_op):
* bytecode.c (reinit_vars_of_bytecode):
* emacs.c (main_1):
* eval.c (funcall_compiled_function):
* symsinit.h:
Any time we change either the instruction pointer or the stack
pointer, assert that we're going to move it to a valid location.
This should catch failures right when they occur rather than
sometime later. This requires that we pass in another couple of
parameters into some functions (only with error-checking enabled,
see below).
Also keep track, using a circular queue, of the last 100 byte
opcodes seen, and when we hit an assert failure during byte-code
execution, output the contents of the queue in a nice readable
fashion. This requires that bytecode-ops.h be included a second
time so that a table mapping opcodes to the name of their operation
can be constructed. This table is constructed in new function
reinit_vars_of_bytecode().
Everything in the last two paras happens only when
ERROR_CHECK_BYTE_CODE.
Add some longish comments describing how the arrays that hold the
stack and instructions, and the pointers used to access them, work.
* gc.c:
Import some code from my `latest-fix' workspace to mark the
staticpro's in order from lowest to highest, rather than highest to
lowest, so it's easier to debug when something goes wrong.
* lisp.h (abort_with_message): Renamed from abort_with_msg().
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symeval.h (DEFVAR_SYMVAL_FWD_OBJECT):
Make the various calls to staticpro() instead call staticpro_1(),
passing in the name of the C var being staticpro'ed, so that it
shows up in staticpro_names. Otherwise staticpro_names just has
1000+ copies of the word `location'.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Wed, 03 Feb 2010 08:01:55 -0600 |
parents | 1628e3b9601a |
children | 8934492a0e97 |
files | src/ChangeLog src/alloc.c src/bytecode-ops.h src/bytecode.c src/bytecode.h src/emacs.c src/eval.c src/gc.c src/lisp.h src/lread.c src/symbols.c src/symeval.h src/symsinit.h |
diffstat | 13 files changed, 626 insertions(+), 218 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Tue Feb 02 15:19:15 2010 -0600 +++ b/src/ChangeLog Wed Feb 03 08:01:55 2010 -0600 @@ -1,3 +1,97 @@ +2010-02-03 Ben Wing <ben@xemacs.org> + + * alloc.c (Fmake_byte_code): + * bytecode.h: + * lisp.h: + * lread.c: + * lread.c (readevalloop): + * lread.c (Fread): + * lread.c (Fread_from_string): + * lread.c (read_list_conser): + * lread.c (read_list): + * lread.c (vars_of_lread): + * symbols.c: + * symbols.c (Fdefine_function): + Turn on the "compiled-function annotation hack". Implement it + properly by hooking into Fdefalias(). Note in the docstring to + `defalias' that we do this. Remove some old broken code and + change code that implemented the old kludgy way of hooking into + the Lisp reader into bracketed by `#ifdef + COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY', which is not enabled. + + Also enable byte-code metering when DEBUG_XEMACS -- this is a form + of profiling for computing histograms of which sequences of two + bytecodes are used most often. + + * bytecode-ops.h: + * bytecode-ops.h (OPCODE): + New file. Extract out all the opcodes and declare them using + OPCODE(), a bit like frame slots and such. This way the file can + be included multiple times if necessary to iterate multiple times + over the byte opcodes. + + * bytecode.c: + * bytecode.c (NUM_REMEMBERED_BYTE_OPS): + * bytecode.c (OPCODE): + * bytecode.c (assert_failed_with_remembered_ops): + * bytecode.c (READ_UINT_2): + * bytecode.c (READ_INT_1): + * bytecode.c (READ_INT_2): + * bytecode.c (PEEK_INT_1): + * bytecode.c (PEEK_INT_2): + * bytecode.c (JUMP_RELATIVE): + * bytecode.c (JUMP_NEXT): + * bytecode.c (PUSH): + * bytecode.c (POP_WITH_MULTIPLE_VALUES): + * bytecode.c (DISCARD): + * bytecode.c (UNUSED): + * bytecode.c (optimize_byte_code): + * bytecode.c (optimize_compiled_function): + * bytecode.c (Fbyte_code): + * bytecode.c (vars_of_bytecode): + * bytecode.c (init_opcode_table_multi_op): + * bytecode.c (reinit_vars_of_bytecode): + * emacs.c (main_1): + * eval.c (funcall_compiled_function): + * symsinit.h: + Any time we change either the instruction pointer or the stack + pointer, assert that we're going to move it to a valid location. + This should catch failures right when they occur rather than + sometime later. This requires that we pass in another couple of + parameters into some functions (only with error-checking enabled, + see below). + + Also keep track, using a circular queue, of the last 100 byte + opcodes seen, and when we hit an assert failure during byte-code + execution, output the contents of the queue in a nice readable + fashion. This requires that bytecode-ops.h be included a second + time so that a table mapping opcodes to the name of their operation + can be constructed. This table is constructed in new function + reinit_vars_of_bytecode(). + + Everything in the last two paras happens only when + ERROR_CHECK_BYTE_CODE. + + Add some longish comments describing how the arrays that hold the + stack and instructions, and the pointers used to access them, work. + + * gc.c: + Import some code from my `latest-fix' workspace to mark the + staticpro's in order from lowest to highest, rather than highest to + lowest, so it's easier to debug when something goes wrong. + + * lisp.h (abort_with_message): Renamed from abort_with_msg(). + + * symbols.c (defsymbol_massage_name_1): + * symbols.c (defsymbol_nodump): + * symbols.c (defsymbol): + * symbols.c (defkeyword): + * symeval.h (DEFVAR_SYMVAL_FWD_OBJECT): + Make the various calls to staticpro() instead call staticpro_1(), + passing in the name of the C var being staticpro'ed, so that it + shows up in staticpro_names. Otherwise staticpro_names just has + 1000+ copies of the word `location'. + 2010-02-02 Ben Wing <ben@xemacs.org> * bytecode.c (execute_rare_opcode):
--- a/src/alloc.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/alloc.c Wed Feb 03 08:01:55 2010 -0600 @@ -1930,19 +1930,12 @@ f->stack_depth = (unsigned short) XINT (stack_depth); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY if (!NILP (Vcurrent_compiled_function_annotation)) - f->annotated = Fcopy (Vcurrent_compiled_function_annotation); - else if (!NILP (Vload_file_name_internal_the_purecopy)) - f->annotated = Vload_file_name_internal_the_purecopy; - else if (!NILP (Vload_file_name_internal)) - { - struct gcpro gcpro1; - GCPRO1 (fun); /* don't let fun get reaped */ - Vload_file_name_internal_the_purecopy = - Ffile_name_nondirectory (Vload_file_name_internal); - f->annotated = Vload_file_name_internal_the_purecopy; - UNGCPRO; - } + f->annotated = Vcurrent_compiled_function_annotation; + else +#endif /* COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY */ + f->annotated = Vload_file_name_internal; #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ /* doc_string may be nil, string, int, or a cons (string . int).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/bytecode-ops.h Wed Feb 03 08:01:55 2010 -0600 @@ -0,0 +1,185 @@ +/* Execution of byte code produced by bytecomp.el. + Implementation of compiled-function objects. + Copyright (C) 1992, 1993 Free Software Foundation, Inc. + Copyright (C) 1995, 2002, 2010 Ben Wing. + +This file is part of XEmacs. + +XEmacs 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 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Mule 2.0, FSF 19.30. */ + +/* There is more than one place in bytecode.c that may want to do something + with the list of all the opcodes. To handle this, we extract them into + a separate file that can get included after defining OPCODE(sym, val) + appropriately. No need to undefine OPCODE; that happens automatically. +*/ + + OPCODE (varref, 010) + OPCODE (varset, 020) + OPCODE (varbind, 030) + OPCODE (call, 040) + OPCODE (unbind, 050) + + OPCODE (nth, 070) + OPCODE (symbolp, 071) + OPCODE (consp, 072) + OPCODE (stringp, 073) + OPCODE (listp, 074) + OPCODE (old_eq, 075) + OPCODE (old_memq, 076) + OPCODE (not, 077) + OPCODE (car, 0100) + OPCODE (cdr, 0101) + OPCODE (cons, 0102) + OPCODE (list1, 0103) + OPCODE (list2, 0104) + OPCODE (list3, 0105) + OPCODE (list4, 0106) + OPCODE (length, 0107) + OPCODE (aref, 0110) + OPCODE (aset, 0111) + OPCODE (symbol_value, 0112) + OPCODE (symbol_function, 0113) + OPCODE (set, 0114) + OPCODE (fset, 0115) + OPCODE (get, 0116) + OPCODE (substring, 0117) + OPCODE (concat2, 0120) + OPCODE (concat3, 0121) + OPCODE (concat4, 0122) + OPCODE (sub1, 0123) + OPCODE (add1, 0124) + OPCODE (eqlsign, 0125) + OPCODE (gtr, 0126) + OPCODE (lss, 0127) + OPCODE (leq, 0130) + OPCODE (geq, 0131) + OPCODE (diff, 0132) + OPCODE (negate, 0133) + OPCODE (plus, 0134) + OPCODE (max, 0135) + OPCODE (min, 0136) + OPCODE (mult, 0137) + + OPCODE (point, 0140) + OPCODE (eq, 0141) /* was Bmark, but no longer + generated as of v18 */ + OPCODE (goto_char, 0142) + OPCODE (insert, 0143) + OPCODE (point_max, 0144) + OPCODE (point_min, 0145) + OPCODE (char_after, 0146) + OPCODE (following_char, 0147) + OPCODE (preceding_char, 0150) + OPCODE (current_column, 0151) + OPCODE (indent_to, 0152) + OPCODE (equal, 0153) /* was Bscan_buffer, but no + longer generated as of + v18 */ + OPCODE (eolp, 0154) + OPCODE (eobp, 0155) + OPCODE (bolp, 0156) + OPCODE (bobp, 0157) + OPCODE (current_buffer, 0160) + OPCODE (set_buffer, 0161) + OPCODE (save_current_buffer, 0162) /* was Bread_char, but no + longer generated as of + v19 */ + OPCODE (memq, 0163) /* was Bset_mark, but no + longer generated as of + v18 */ + OPCODE (interactive_p, 0164) /* Needed since interactive-p + takes unevalled args */ + OPCODE (forward_char, 0165) + OPCODE (forward_word, 0166) + OPCODE (skip_chars_forward, 0167) + OPCODE (skip_chars_backward, 0170) + OPCODE (forward_line, 0171) + OPCODE (char_syntax, 0172) + OPCODE (buffer_substring, 0173) + OPCODE (delete_region, 0174) + OPCODE (narrow_to_region, 0175) + OPCODE (widen, 0176) + OPCODE (end_of_line, 0177) + + OPCODE (constant2, 0201) + OPCODE (goto, 0202) + OPCODE (gotoifnil, 0203) + OPCODE (gotoifnonnil, 0204) + OPCODE (gotoifnilelsepop, 0205) + OPCODE (gotoifnonnilelsepop, 0206) + OPCODE (return, 0207) + OPCODE (discard, 0210) + OPCODE (dup, 0211) + + OPCODE (save_excursion, 0212) + OPCODE (save_window_excursion, 0213) + OPCODE (save_restriction, 0214) + OPCODE (catch, 0215) + + OPCODE (unwind_protect, 0216) + OPCODE (condition_case, 0217) + OPCODE (temp_output_buffer_setup, 0220) + OPCODE (temp_output_buffer_show, 0221) + + OPCODE (unbind_all, 0222) + + OPCODE (set_marker, 0223) + OPCODE (match_beginning, 0224) + OPCODE (match_end, 0225) + OPCODE (upcase, 0226) + OPCODE (downcase, 0227) + + OPCODE (string_equal, 0230) + OPCODE (string_lessp, 0231) + OPCODE (old_equal, 0232) + OPCODE (nthcdr, 0233) + OPCODE (elt, 0234) + OPCODE (old_member, 0235) + OPCODE (old_assq, 0236) + OPCODE (nreverse, 0237) + OPCODE (setcar, 0240) + OPCODE (setcdr, 0241) + OPCODE (car_safe, 0242) + OPCODE (cdr_safe, 0243) + OPCODE (nconc, 0244) + OPCODE (quo, 0245) + OPCODE (rem, 0246) + OPCODE (numberp, 0247) + OPCODE (fixnump, 0250) /* Was Bintegerp. */ + + OPCODE (Rgoto, 0252) + OPCODE (Rgotoifnil, 0253) + OPCODE (Rgotoifnonnil, 0254) + OPCODE (Rgotoifnilelsepop, 0255) + OPCODE (Rgotoifnonnilelsepop, 0256) + + OPCODE (listN, 0257) + OPCODE (concatN, 0260) + OPCODE (insertN, 0261) + + OPCODE (bind_multiple_value_limits, 0262) /* New in 21.5. */ + OPCODE (multiple_value_list_internal, 0263) /* New in 21.5. */ + OPCODE (multiple_value_call, 0264) /* New in 21.5. */ + OPCODE (throw, 0265) /* New in 21.5. */ + + OPCODE (member, 0266) /* new in v20 */ + OPCODE (assq, 0267) /* new in v20 */ + + OPCODE (constant, 0300) + +#undef OPCODE
--- a/src/bytecode.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/bytecode.c Wed Feb 03 08:01:55 2010 -0600 @@ -58,6 +58,8 @@ #include "syntax.h" #include "window.h" +#define NUM_REMEMBERED_BYTE_OPS 100 + #ifdef NEW_GC static Lisp_Object make_compiled_function_args (int totalargs) @@ -101,169 +103,104 @@ Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code; + enum Opcode /* Byte codes */ { - Bvarref = 010, - Bvarset = 020, - Bvarbind = 030, - Bcall = 040, - Bunbind = 050, - - Bnth = 070, - Bsymbolp = 071, - Bconsp = 072, - Bstringp = 073, - Blistp = 074, - Bold_eq = 075, - Bold_memq = 076, - Bnot = 077, - Bcar = 0100, - Bcdr = 0101, - Bcons = 0102, - Blist1 = 0103, - Blist2 = 0104, - Blist3 = 0105, - Blist4 = 0106, - Blength = 0107, - Baref = 0110, - Baset = 0111, - Bsymbol_value = 0112, - Bsymbol_function = 0113, - Bset = 0114, - Bfset = 0115, - Bget = 0116, - Bsubstring = 0117, - Bconcat2 = 0120, - Bconcat3 = 0121, - Bconcat4 = 0122, - Bsub1 = 0123, - Badd1 = 0124, - Beqlsign = 0125, - Bgtr = 0126, - Blss = 0127, - Bleq = 0130, - Bgeq = 0131, - Bdiff = 0132, - Bnegate = 0133, - Bplus = 0134, - Bmax = 0135, - Bmin = 0136, - Bmult = 0137, - - Bpoint = 0140, - Beq = 0141, /* was Bmark, - but no longer generated as of v18 */ - Bgoto_char = 0142, - Binsert = 0143, - Bpoint_max = 0144, - Bpoint_min = 0145, - Bchar_after = 0146, - Bfollowing_char = 0147, - Bpreceding_char = 0150, - Bcurrent_column = 0151, - Bindent_to = 0152, - Bequal = 0153, /* was Bscan_buffer, - but no longer generated as of v18 */ - Beolp = 0154, - Beobp = 0155, - Bbolp = 0156, - Bbobp = 0157, - Bcurrent_buffer = 0160, - Bset_buffer = 0161, - Bsave_current_buffer = 0162, /* was Bread_char, - but no longer generated as of v19 */ - Bmemq = 0163, /* was Bset_mark, - but no longer generated as of v18 */ - Binteractive_p = 0164, /* Needed since interactive-p takes - unevalled args */ - Bforward_char = 0165, - Bforward_word = 0166, - Bskip_chars_forward = 0167, - Bskip_chars_backward = 0170, - Bforward_line = 0171, - Bchar_syntax = 0172, - Bbuffer_substring = 0173, - Bdelete_region = 0174, - Bnarrow_to_region = 0175, - Bwiden = 0176, - Bend_of_line = 0177, - - Bconstant2 = 0201, - Bgoto = 0202, - Bgotoifnil = 0203, - Bgotoifnonnil = 0204, - Bgotoifnilelsepop = 0205, - Bgotoifnonnilelsepop = 0206, - Breturn = 0207, - Bdiscard = 0210, - Bdup = 0211, - - Bsave_excursion = 0212, - Bsave_window_excursion= 0213, - Bsave_restriction = 0214, - Bcatch = 0215, - - Bunwind_protect = 0216, - Bcondition_case = 0217, - Btemp_output_buffer_setup = 0220, - Btemp_output_buffer_show = 0221, - - Bunbind_all = 0222, - - Bset_marker = 0223, - Bmatch_beginning = 0224, - Bmatch_end = 0225, - Bupcase = 0226, - Bdowncase = 0227, - - Bstring_equal = 0230, - Bstring_lessp = 0231, - Bold_equal = 0232, - Bnthcdr = 0233, - Belt = 0234, - Bold_member = 0235, - Bold_assq = 0236, - Bnreverse = 0237, - Bsetcar = 0240, - Bsetcdr = 0241, - Bcar_safe = 0242, - Bcdr_safe = 0243, - Bnconc = 0244, - Bquo = 0245, - Brem = 0246, - Bnumberp = 0247, - Bfixnump = 0250, /* Was Bintegerp. */ - - BRgoto = 0252, - BRgotoifnil = 0253, - BRgotoifnonnil = 0254, - BRgotoifnilelsepop = 0255, - BRgotoifnonnilelsepop = 0256, - - BlistN = 0257, - BconcatN = 0260, - BinsertN = 0261, - - Bbind_multiple_value_limits = 0262, /* New in 21.5. */ - Bmultiple_value_list_internal = 0263, /* New in 21.5. */ - Bmultiple_value_call = 0264, /* New in 21.5. */ - Bthrow = 0265, /* New in 21.5. */ - - Bmember = 0266, /* new in v20 */ - Bassq = 0267, /* new in v20 */ - - Bconstant = 0300 +#define OPCODE(sym, val) B##sym = val, +#include "bytecode-ops.h" }; typedef enum Opcode Opcode; - Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr, +#ifdef ERROR_CHECK_BYTE_CODE + Lisp_Object *stack_beg, + Lisp_Object *stack_end, +#endif /* ERROR_CHECK_BYTE_CODE */ const Opbyte *program_ptr, Opcode opcode); -/* Define BYTE_CODE_METER to enable generation of a byte-op usage histogram. - This isn't defined in FSF Emacs and isn't defined in XEmacs v19. */ -/* #define BYTE_CODE_METER */ +#ifndef ERROR_CHECK_BYTE_CODE + +# define bytecode_assert(x) disabled_assert (x) +# define bytecode_assert_with_message(x, msg) disabled_assert(x) +# define bytecode_abort_with_message(msg) abort_with_message (msg) + +#else /* ERROR_CHECK_BYTE_CODE */ + +# define bytecode_assert(x) \ + ((x) ? (void) 0 : assert_failed_with_remembered_ops (__FILE__, __LINE__, #x)) +# define bytecode_assert_with_message(x, msg) \ + ((x) ? (void) 0 : assert_failed_with_remembered_ops (__FILE__, __LINE__, msg)) +# define bytecode_abort_with_message(msg) \ + assert_failed_with_remembered_ops (__FILE__, __LINE__, msg) + +/* Table mapping opcodes to their names. This handles opcodes like + Bvarref+7, but it doesn't list any of the Bconstant+N opcodes; those + are handled specially. */ +Ascbyte *opcode_name_table[256]; + +/* Circular queue remembering the most recent operations. */ +Opcode remembered_ops[NUM_REMEMBERED_BYTE_OPS]; +int remembered_op_next_pos, num_remembered; + +static void +remember_operation (Opcode op) +{ + remembered_ops[remembered_op_next_pos] = op; + remembered_op_next_pos = + (remembered_op_next_pos + 1) % NUM_REMEMBERED_BYTE_OPS; + if (num_remembered < NUM_REMEMBERED_BYTE_OPS) + num_remembered++; +} + +static void +assert_failed_with_remembered_ops (const Ascbyte *file, int line, + Ascbyte *msg_to_abort_with) +{ + Ascbyte *msg = + alloca_array (Ascbyte, + NUM_REMEMBERED_BYTE_OPS*50 + strlen (msg_to_abort_with)); + int i; + + if (msg_to_abort_with) + strcpy (msg, msg_to_abort_with); + strcat (msg, "\n\nRecent bytecodes, oldest first:\n\n"); + + for (i = 0; i < num_remembered; i++) + { + Ascbyte msg2[50]; + int pos; + Opcode op; + + sprintf (msg2, "%5d: ", i - num_remembered + 1); + strcat (msg, msg2); + pos = (remembered_op_next_pos + NUM_REMEMBERED_BYTE_OPS + + i - num_remembered) % NUM_REMEMBERED_BYTE_OPS; + op = remembered_ops[pos]; + if (op >= Bconstant) + { + sprintf (msg2, "constant+%d", op - Bconstant); + strcat (msg, msg2); + } + else + { + Ascbyte *opname = opcode_name_table[op]; + if (!opname) + { + stderr_out ("Internal error! NULL pointer in opcode_name_table, opcode %d\n", op); + strcat (msg, "NULL"); + } + else + strcat (msg, opname); + } + sprintf (msg2, " (%d)\n", op); + strcat (msg, msg2); + } + + assert_failed (file, line, msg); +} + +#endif /* ERROR_CHECK_BYTE_CODE */ #ifdef BYTE_CODE_METER @@ -619,72 +556,127 @@ } + +/*********************** The instruction array *********************/ + +/* Check that there are at least LEN elements left in the end of the + instruction array before fetching them. Note that we allow for + PROGRAM_PTR == PROGRAM_END after the fetch -- that means there are + no more elements to fetch next time around, but we might exit before + next time comes. + + When checking the destination if jumps, however, we don't allow + PROGRAM_PTR to equal PROGRAM_END, since we will always be fetching + another instruction after the jump. */ + +#define CHECK_OPCODE_SPACE(len) \ + bytecode_assert (program_ptr + len <= program_end) + /* Read next uint8 from the instruction stream. */ -#define READ_UINT_1 ((unsigned int) (unsigned char) *program_ptr++) +#define READ_UINT_1 \ + (CHECK_OPCODE_SPACE (1), (unsigned int) (unsigned char) *program_ptr++) /* Read next uint16 from the instruction stream. */ #define READ_UINT_2 \ - (program_ptr += 2, \ + (CHECK_OPCODE_SPACE (2), \ + program_ptr += 2, \ (((unsigned int) (unsigned char) program_ptr[-1]) * 256 + \ ((unsigned int) (unsigned char) program_ptr[-2]))) /* Read next int8 from the instruction stream. */ -#define READ_INT_1 ((int) (signed char) *program_ptr++) +#define READ_INT_1 \ + (CHECK_OPCODE_SPACE (1), (int) (signed char) *program_ptr++) /* Read next int16 from the instruction stream. */ #define READ_INT_2 \ - (program_ptr += 2, \ + (CHECK_OPCODE_SPACE (2), \ + program_ptr += 2, \ (((int) ( signed char) program_ptr[-1]) * 256 + \ ((int) (unsigned char) program_ptr[-2]))) /* Read next int8 from instruction stream; don't advance program_pointer */ -#define PEEK_INT_1 ((int) (signed char) program_ptr[0]) +#define PEEK_INT_1 \ + (CHECK_OPCODE_SPACE (1), (int) (signed char) program_ptr[0]) /* Read next int16 from instruction stream; don't advance program_pointer */ #define PEEK_INT_2 \ - ((((int) ( signed char) program_ptr[1]) * 256) | \ + (CHECK_OPCODE_SPACE (2), \ + (((int) ( signed char) program_ptr[1]) * 256) | \ ((int) (unsigned char) program_ptr[0])) /* Do relative jumps from the current location. We only do a QUIT if we jump backwards, for efficiency. No infloops without backward jumps! */ -#define JUMP_RELATIVE(jump) do { \ - int JR_jump = (jump); \ - if (JR_jump < 0) QUIT; \ - program_ptr += JR_jump; \ +#define JUMP_RELATIVE(jump) do { \ + int _JR_jump = (jump); \ + if (_JR_jump < 0) QUIT; \ + /* Check that where we're going to is in range. Note that we don't use \ + CHECK_OPCODE_SPACE() -- that only checks the end, and it allows \ + program_ptr == program_end, which we don't allow. */ \ + bytecode_assert (program_ptr + _JR_jump >= program && \ + program_ptr + _JR_jump < program_end); \ + program_ptr += _JR_jump; \ } while (0) #define JUMP JUMP_RELATIVE (PEEK_INT_2) #define JUMPR JUMP_RELATIVE (PEEK_INT_1) -#define JUMP_NEXT ((void) (program_ptr += 2)) -#define JUMPR_NEXT ((void) (program_ptr += 1)) +#define JUMP_NEXT (CHECK_OPCODE_SPACE (2), (void) (program_ptr += 2)) +#define JUMPR_NEXT (CHECK_OPCODE_SPACE (1), (void) (program_ptr += 1)) + +/*********************** The stack array *********************/ + +/* NOTE: The stack array doesn't work quite like you'd expect. + + STACK_PTR points to the value on the top of the stack. Popping a value + fetches the value from the STACK_PTR and then decrements it. Pushing a + value first increments it, then writes the new value. STACK_PTR - + STACK_BEG is the number of elements on the stack. + + This means that when STACK_PTR == STACK_BEG, the stack is empty, and + the space at STACK_BEG is never written to -- the first push will write + into the space directly after STACK_BEG. This is why the call to + alloca_array() below has a count of `stack_depth + 1', and why + we GCPRO1 (stack_ptr[1]) -- the value at stack_ptr[0] is unused and + uninitialized. + + Also, STACK_END actually points to the last usable storage location, + and does not point past the end, like you'd expect. */ + +#define CHECK_STACKPTR_OFFSET(len) \ + bytecode_assert (stack_ptr + (len) >= stack_beg && \ + stack_ptr + (len) <= stack_end) /* Push x onto the execution stack. */ -#define PUSH(x) (*++stack_ptr = (x)) +#define PUSH(x) (CHECK_STACKPTR_OFFSET (1), *++stack_ptr = (x)) /* Pop a value, which may be multiple, off the execution stack. */ -#define POP_WITH_MULTIPLE_VALUES (*stack_ptr--) +#define POP_WITH_MULTIPLE_VALUES (CHECK_STACKPTR_OFFSET (-1), *stack_ptr--) /* Pop a value off the execution stack, treating multiple values as single. */ #define POP (IGNORE_MULTIPLE_VALUES (POP_WITH_MULTIPLE_VALUES)) -#define DISCARD_PRESERVING_MULTIPLE_VALUES(n) (stack_ptr -= (n)) +/* ..._UNSAFE() means it evaluates its argument more than once. */ +#define DISCARD_PRESERVING_MULTIPLE_VALUES_UNSAFE(n) \ + (CHECK_STACKPTR_OFFSET (-(n)), stack_ptr -= (n)) /* Discard n values from the execution stack. */ #define DISCARD(n) do { \ + int _discard_n = (n); \ if (1 != multiple_value_current_limit) \ { \ - int i, en = n; \ - for (i = 0; i < en; i++) \ + int i; \ + for (i = 0; i < _discard_n; i++) \ { \ + CHECK_STACKPTR_OFFSET (-1); \ *stack_ptr = ignore_multiple_values (*stack_ptr); \ stack_ptr--; \ } \ } \ else \ { \ - stack_ptr -= (n); \ + CHECK_STACKPTR_OFFSET (-_discard_n); \ + stack_ptr -= _discard_n; \ } \ } while (0) @@ -705,6 +697,7 @@ /* See comment before the big switch in execute_optimized_program(). */ #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg) + /* The actual interpreter for byte code. This function has been seriously optimized for performance. Don't change the constructs unless you are willing to do @@ -713,11 +706,18 @@ Lisp_Object execute_optimized_program (const Opbyte *program, +#ifdef ERROR_CHECK_BYTE_CODE + Elemcount program_length, +#endif int stack_depth, Lisp_Object *constants_data) { /* This function can GC */ REGISTER const Opbyte *program_ptr = (Opbyte *) program; +#ifdef ERROR_CHECK_BYTE_CODE + const Opbyte *program_end = program_ptr + program_length; +#endif + /* See comment above explaining the `+ 1' */ Lisp_Object *stack_beg = alloca_array (Lisp_Object, stack_depth + 1); REGISTER Lisp_Object *stack_ptr = stack_beg; int speccount = specpdl_depth (); @@ -759,13 +759,22 @@ return from the interpreter do we need to finalize the struct gcpro itself, and that's done at case Breturn. */ + + /* See comment above explaining the `[1]' */ GCPRO1 (stack_ptr[1]); while (1) { REGISTER Opcode opcode = (Opcode) READ_UINT_1; +#ifdef ERROR_CHECK_BYTE_CODE + remember_operation (opcode); +#endif + GCPRO_STACK; /* Get nvars right before maybe signaling. */ + /* #### NOTE: This code should probably never get triggered, since we + now catch the problems earlier, farther down, before we ever set + a bad value for STACK_PTR. */ #ifdef ERROR_CHECK_BYTE_CODE if (stack_ptr > stack_end) stack_overflow ("byte code stack overflow", Qunbound); @@ -790,7 +799,13 @@ { /* We're not sure what these do, so better safe than sorry. */ /* GCPRO_STACK; */ - stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode); + stack_ptr = execute_rare_opcode (stack_ptr, +#ifdef ERROR_CHECK_BYTE_CODE + stack_beg, + stack_end, +#endif /* ERROR_CHECK_BYTE_CODE */ + program_ptr, opcode); + CHECK_STACKPTR_OFFSET (0); } break; @@ -1438,6 +1453,10 @@ Don't make this function static, since then the compiler might inline it. */ Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr, +#ifdef ERROR_CHECK_BYTE_CODE + Lisp_Object *stack_beg, + Lisp_Object *stack_end, +#endif /* ERROR_CHECK_BYTE_CODE */ const Opbyte *UNUSED (program_ptr), Opcode opcode) { @@ -1445,7 +1464,7 @@ switch (opcode) { - + case Bsave_excursion: record_unwind_protect (save_excursion_restore, save_excursion_save ()); @@ -1714,7 +1733,7 @@ case Bmultiple_value_call: { n = XINT (POP); - DISCARD_PRESERVING_MULTIPLE_VALUES (n - 1); + DISCARD_PRESERVING_MULTIPLE_VALUES_UNSAFE (n - 1); /* Discard multiple values for the first (function) argument: */ TOP_LVALUE = TOP; TOP_LVALUE = multiple_value_call (n, TOP_ADDRESS); @@ -1723,7 +1742,7 @@ case Bmultiple_value_list_internal: { - DISCARD_PRESERVING_MULTIPLE_VALUES (3); + DISCARD_PRESERVING_MULTIPLE_VALUES_UNSAFE (3); TOP_LVALUE = multiple_value_list_internal (4, TOP_ADDRESS); break; } @@ -1741,7 +1760,7 @@ { Ascbyte msg[100]; sprintf (msg, "Unknown opcode %d", opcode); - abort_with_msg (msg); + bytecode_abort_with_message (msg); } break; } @@ -1866,8 +1885,8 @@ Lisp_Object constants, /* out */ Opbyte * const program, - int * const program_length, - int * const varbind_count) + Elemcount * const program_length, + Elemcount * const varbind_count) { Bytecount instructions_length = XSTRING_LENGTH (instructions); Elemcount comfy_size = (Elemcount) (2 * instructions_length); @@ -2131,8 +2150,8 @@ optimize_compiled_function (Lisp_Object compiled_function) { Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (compiled_function); - int program_length; - int varbind_count; + Elemcount program_length; + Elemcount varbind_count; Opbyte *program; { @@ -2704,8 +2723,8 @@ (instructions, constants, stack_depth)) { /* This function can GC */ - int varbind_count; - int program_length; + Elemcount varbind_count; + Elemcount program_length; Opbyte *program; CHECK_STRING (instructions); @@ -2720,6 +2739,9 @@ &program_length, &varbind_count); SPECPDL_RESERVE (varbind_count); return execute_optimized_program (program, +#ifdef ERROR_CHECK_BYTE_CODE + program_length, +#endif XINT (stack_depth), XVECTOR_DATA (constants)); } @@ -2762,7 +2784,6 @@ vars_of_bytecode (void) { #ifdef BYTE_CODE_METER - DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter /* A vector of vectors which holds a histogram of byte code usage. \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte @@ -2787,3 +2808,57 @@ } #endif /* BYTE_CODE_METER */ } + +#ifdef ERROR_CHECK_BYTE_CODE + +/* Initialize the opcodes in the table that correspond to a base opcode + plus an offset (except for Bconstant). */ + +static void +init_opcode_table_multi_op (Opcode op) +{ + Ascbyte *basename = opcode_name_table[op]; + Ascbyte temp[300]; + int i; + + for (i = 1; i < 7; i++) + { + assert (!opcode_name_table[op + i]); + sprintf (temp, "%s+%d", basename, i); + opcode_name_table[op + i] = xstrdup (temp); + } +} + +#endif /* ERROR_CHECK_BYTE_CODE */ + +void +reinit_vars_of_bytecode (void) +{ +#ifdef ERROR_CHECK_BYTE_CODE + int i; + +#define OPCODE(sym, val) opcode_name_table[val] = xstrdup (#sym); +#include "bytecode-ops.h" + + for (i = 0; i < countof (opcode_name_table); i++) + { + int j; + Ascbyte *name = opcode_name_table[i]; + if (name) + { + Bytecount len = strlen (name); + /* Prettify the name by converting underscores to hyphens, similar + to what happens with DEFSYMBOL. */ + for (j = 0; j < len; j++) + if (name[j] == '_') + name[j] = '-'; + } + } + + init_opcode_table_multi_op (Bvarref); + init_opcode_table_multi_op (Bvarset); + init_opcode_table_multi_op (Bvarbind); + init_opcode_table_multi_op (Bcall); + init_opcode_table_multi_op (Bunbind); +#endif /* ERROR_CHECK_BYTE_CODE */ +}
--- a/src/bytecode.h Tue Feb 02 15:19:15 2010 -0600 +++ b/src/bytecode.h Wed Feb 03 08:01:55 2010 -0600 @@ -67,8 +67,19 @@ #define COMPILED_INTERACTIVE 5 #define COMPILED_DOMAIN 6 -/* It doesn't make sense to have this and also have load-history */ -/* #define COMPILED_FUNCTION_ANNOTATION_HACK */ +/* Someone claims: [[ It doesn't make sense to have this and also have + load-history ]] But in fact they are quite different things. Perhaps + we should turn this on only when DEBUG_XEMACS but there's no speed + harm at all, so no reason not to do it always. */ +#define COMPILED_FUNCTION_ANNOTATION_HACK + +#ifdef DEBUG_XEMACS +/* Define BYTE_CODE_METER to enable generation of a byte-op usage + histogram. This isn't defined in FSF Emacs and isn't defined in XEmacs + v19. But this is precisely the thing to turn on when DEBUG_XEMACS. It + may lead to a slight speed penalty but nothing major. */ +#define BYTE_CODE_METER +#endif struct Lisp_Compiled_Function { @@ -131,6 +142,9 @@ typedef unsigned char Opbyte; Lisp_Object execute_optimized_program (const Opbyte *program, +#ifdef ERROR_CHECK_BYTE_CODE + Elemcount program_length, +#endif int stack_depth, Lisp_Object *constants_data);
--- a/src/emacs.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/emacs.c Wed Feb 03 08:01:55 2010 -0600 @@ -2295,6 +2295,7 @@ /* Now do additional vars_of_*() initialization that happens both at dump time and after pdump load. */ reinit_vars_of_buffer (); + reinit_vars_of_bytecode (); reinit_vars_of_console (); #ifdef DEBUG_XEMACS reinit_vars_of_debug ();
--- a/src/eval.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/eval.c Wed Feb 03 08:01:55 2010 -0600 @@ -3620,6 +3620,10 @@ { Lisp_Object value = execute_optimized_program ((Opbyte *) XOPAQUE_DATA (f->instructions), +#ifdef ERROR_CHECK_BYTE_CODE + XOPAQUE_SIZE (f->instructions) / + sizeof (Opbyte), +#endif f->stack_depth, XVECTOR_DATA (f->constants));
--- a/src/gc.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/gc.c Wed Feb 03 08:01:55 2010 -0600 @@ -1624,8 +1624,9 @@ { /* staticpro() */ Lisp_Object **p = Dynarr_begin (staticpros); + Elemcount len = Dynarr_length (staticpros); Elemcount count; - for (count = Dynarr_length (staticpros); count; count--, p++) + for (count = 0; count < len; count++, p++) /* Need to check if the pointer in the staticpro array is not NULL. A gc can occur after variable is added to the staticpro array and _before_ it is correctly initialized. In this case @@ -1636,8 +1637,9 @@ { /* staticpro_nodump() */ Lisp_Object **p = Dynarr_begin (staticpros_nodump); + Elemcount len = Dynarr_length (staticpros_nodump); Elemcount count; - for (count = Dynarr_length (staticpros_nodump); count; count--, p++) + for (count = 0; count < len; count++, p++) /* Need to check if the pointer in the staticpro array is not NULL. A gc can occur after variable is added to the staticpro array and _before_ it is correctly initialized. In this case @@ -1649,9 +1651,10 @@ #ifdef NEW_GC { /* mcpro () */ Lisp_Object *p = Dynarr_begin (mcpros); + Elemcount len = Dynarr_length (mcpros); Elemcount count; - for (count = Dynarr_length (mcpros); count; count--) - mark_object (*p++); + for (count = 0; count < len; count++, p++) + mark_object (*p); } #endif /* NEW_GC */
--- a/src/lisp.h Tue Feb 02 15:19:15 2010 -0600 +++ b/src/lisp.h Wed Feb 03 08:01:55 2010 -0600 @@ -1254,7 +1254,7 @@ /* (thanks, Jamie, I feel better now -- ben) */ MODULE_API void assert_failed (const Ascbyte *, int, const Ascbyte *); #define ABORT() assert_failed (__FILE__, __LINE__, "ABORT()") -#define abort_with_msg(msg) assert_failed (__FILE__, __LINE__, msg) +#define abort_with_message(msg) assert_failed (__FILE__, __LINE__, msg) /* This used to be ((void) (0)) but that triggers lots of unused variable warnings. It's pointless to force all that code to be rewritten, with @@ -6009,7 +6009,7 @@ extern Lisp_Object Vcommand_line_args, Vconfigure_info_directory; extern Lisp_Object Vconfigure_site_directory, Vconfigure_site_module_directory; extern Lisp_Object Vconsole_list, Vcontrolling_terminal; -extern Lisp_Object Vcurrent_compiled_function_annotation, Vcurrent_load_list; +extern Lisp_Object Vcurrent_load_list; extern Lisp_Object Vcurrent_mouse_event, Vcurrent_prefix_arg, Vdata_directory; extern Lisp_Object Vdirectory_sep_char, Vdisabled_command_hook; extern Lisp_Object Vdoc_directory, Vinternal_doc_file_name;
--- a/src/lread.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/lread.c Wed Feb 03 08:01:55 2010 -0600 @@ -1,7 +1,7 @@ /* Lisp parsing and input streams. Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems. - Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing. This file is part of XEmacs. @@ -148,7 +148,36 @@ /* A resizing-buffer stream used to temporarily hold data while reading */ static Lisp_Object Vread_buffer_stream; -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY +/* The stuff throughout this file that sets the following variable is + concerned with old-style .elc files that set up compiled functions using + + (fset 'fun #[... ...]) + + Where #[... ...] is a literal compiled-function object. We want the + name of the function to get stored as the annotation, so in a clever but + nastily kludgy fashion, we hack the code that reads lists so that if it + sees a symbol `fset' as the first argument, it stores the second argument + in Vcurrent_compiled_function_annotation, and then when the third + argument gets read and a compiled-function object created by a call to + Fmake_byte_code(), the stored annotation will get snarfed up. Elsewhere, + we reset Vcurrent_compiled_function_annotation to nil so it's not still + defined in case we have a #[... ...] in other circumstances -- in that + case we use the filename (Vload_file_name_internal). + + Now it's arguable that I should simply have hacked Ffset() + appropriately. This is all moot, however, be nowadays calls that set up + compiled functions look like + + (defalias 'fun #[... ...]) + + Where Fdefalias is like Ffset but sets up load-history for the function. + Hence it's exactly the right place to hack, and it's not even messy. + + When we're sure the annotation mechanism works the new way, delete all + this old nasty code. + + --ben 2-2-10 */ Lisp_Object Vcurrent_compiled_function_annotation; #endif @@ -1451,7 +1480,7 @@ internal_bind_lisp_object (&Vcurrent_load_list, Qnil); -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY Vcurrent_compiled_function_annotation = Qnil; #endif GCPRO2 (val, sourcename); @@ -1619,7 +1648,7 @@ Vread_objects = Qnil; -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY Vcurrent_compiled_function_annotation = Qnil; #endif if (EQ (stream, Qread_char)) @@ -1648,7 +1677,7 @@ Lisp_Object lispstream = Qnil; struct gcpro gcpro1; -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY Vcurrent_compiled_function_annotation = Qnil; #endif GCPRO1 (lispstream); @@ -3009,7 +3038,7 @@ } } -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset)) { if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt))) @@ -3054,7 +3083,7 @@ { struct read_list_state s; struct gcpro gcpro1, gcpro2; -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY Lisp_Object old_compiled_function_annotation = Vcurrent_compiled_function_annotation; #endif @@ -3067,7 +3096,7 @@ GCPRO2 (s.head, s.tail); sequence_reader (readcharfun, terminator, &s, read_list_conser); -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY Vcurrent_compiled_function_annotation = old_compiled_function_annotation; #endif @@ -3477,7 +3506,7 @@ Vload_file_name_internal = Qnil; staticpro (&Vload_file_name_internal); -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK_OLD_WAY Vcurrent_compiled_function_annotation = Qnil; staticpro (&Vcurrent_compiled_function_annotation); #endif
--- a/src/symbols.c Tue Feb 02 15:19:15 2010 -0600 +++ b/src/symbols.c Wed Feb 03 08:01:55 2010 -0600 @@ -54,6 +54,8 @@ #include <config.h> #include "lisp.h" +#include "bytecode.h" /* for COMPILED_FUNCTION_ANNOTATION_HACK, + defined in bytecode.h and used here. */ #include "buffer.h" /* for Vbuffer_defaults */ #include "console-impl.h" #include "elhash.h" @@ -716,12 +718,19 @@ DEFUN ("define-function", Fdefine_function, 2, 2, 0, /* Set SYMBOL's function definition to NEWDEF, and return NEWDEF. Associates the function with the current load file, if any. +If NEWDEF is a compiled-function object, stores the function name in +the `annotated' slot of the compiled-function (retrievable using +`compiled-function-annotation'). */ (symbol, newdef)) { /* This function can GC */ Ffset (symbol, newdef); LOADHIST_ATTACH (Fcons (Qdefun, symbol)); +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK + if (COMPILED_FUNCTIONP (newdef)) + XCOMPILED_FUNCTION (newdef)->annotated = symbol; +#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ return newdef; } @@ -3553,9 +3562,9 @@ temp[i] = '-'; *location = Fintern (make_string ((const Ibyte *) temp, len), Qnil); if (dump_p) - staticpro (location); + staticpro_1 (location, name); else - staticpro_nodump (location); + staticpro_nodump_1 (location, name); } void @@ -3589,7 +3598,7 @@ *location = Fintern (make_string_nocopy ((const Ibyte *) name, strlen (name)), Qnil); - staticpro_nodump (location); + staticpro_nodump_1 (location, name); } void @@ -3598,7 +3607,7 @@ *location = Fintern (make_string_nocopy ((const Ibyte *) name, strlen (name)), Qnil); - staticpro (location); + staticpro_1 (location, name); } void
--- a/src/symeval.h Tue Feb 02 15:19:15 2010 -0600 +++ b/src/symeval.h Wed Feb 03 08:01:55 2010 -0600 @@ -460,7 +460,7 @@ DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \ { \ Lisp_Object *DSF_location = c_location; /* Type check */ \ - staticpro (DSF_location); \ + staticpro_1 (DSF_location, lname); \ if (EQ (*DSF_location, Qnull_pointer)) *DSF_location = Qnil; \ } \ } while (0)
--- a/src/symsinit.h Tue Feb 02 15:19:15 2010 -0600 +++ b/src/symsinit.h Wed Feb 03 08:01:55 2010 -0600 @@ -333,6 +333,7 @@ void vars_of_buffer (void); void reinit_vars_of_buffer (void); void vars_of_bytecode (void); +void reinit_vars_of_bytecode (void); void vars_of_callint (void); EXTERN_C void vars_of_canna_api (void); void vars_of_chartab (void);