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);