--- a/src/bytecode.c	Mon Aug 13 11:19:22 2007 +0200
+++ b/src/bytecode.c	Mon Aug 13 11:20:41 2007 +0200
@@ -28,7 +28,7 @@
 
    FSF: long ago.
 
-hacked on by jwz@jwz.org 1991-06
+hacked on by jwz@netscape.com 1991-06
   o  added a compile-time switch to turn on simple sanity checking;
   o  put back the obsolete byte-codes for error-detection;
   o  added a new instruction, unbind_all, which I will use for
@@ -56,6 +56,9 @@
 #include "opaque.h"
 #include "syntax.h"
 
+#include <stddef.h>
+#include <limits.h>
+
 EXFUN (Ffetch_bytecode, 1);
 
 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
@@ -214,15 +217,21 @@
 static void invalid_byte_code_error (char *error_message, ...);
 
 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
-				   const Opbyte *program_ptr,
+				   CONST Opbyte *program_ptr,
 				   Opcode opcode);
 
-static Lisp_Object execute_optimized_program (const Opbyte *program,
+static Lisp_Object execute_optimized_program (CONST Opbyte *program,
 					      int stack_depth,
 					      Lisp_Object *constants_data);
 
 extern Lisp_Object Qand_rest, Qand_optional;
 
+/* Define ERROR_CHECK_BYTE_CODE to enable some minor sanity checking.
+   Useful for debugging the byte compiler.  */
+#ifdef DEBUG_XEMACS
+#define ERROR_CHECK_BYTE_CODE
+#endif
+
 /* 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 */
@@ -233,17 +242,21 @@
 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
 int byte_metering_on;
 
-static void
-meter_code (Opcode prev_opcode, Opcode this_opcode)
-{
-  if (byte_metering_on)
-    {
-      Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]);
-      p[0] = INT_PLUS1 (p[0]);
-      if (prev_opcode)
-	p[prev_opcode] = INT_PLUS1 (p[prev_opcode]);
-    }
-}
+#define METER_2(code1, code2) \
+  XINT (XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[(code1)])[(code2)])
+
+#define METER_1(code) METER_2 (0, (code))
+
+#define METER_CODE(last_code, this_code) do {				\
+  if (byte_metering_on)							\
+    {									\
+      if (METER_1 (this_code) != ((1<<VALBITS)-1))			\
+        METER_1 (this_code)++;						\
+      if (last_code							\
+	  && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))	\
+        METER_2 (last_code, this_code)++;				\
+    }									\
+} while (0)
 
 #endif /* BYTE_CODE_METER */
 
@@ -253,12 +266,12 @@
 {
  retry:
 
-  if (INTP    (obj)) return make_int (- XINT (obj));
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP  (obj)) return make_float (- XFLOAT_DATA (obj));
 #endif
   if (CHARP   (obj)) return make_int (- ((int) XCHAR (obj)));
   if (MARKERP (obj)) return make_int (- ((int) marker_position (obj)));
+  if (INTP    (obj)) return make_int (- XINT (obj));
 
   obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
   goto retry;
@@ -292,7 +305,7 @@
 
 #ifdef LISP_FLOAT_TYPE
   {
-    EMACS_INT ival1, ival2;
+    int ival1, ival2;
 
     if      (INTP    (obj1)) ival1 = XINT  (obj1);
     else if (CHARP   (obj1)) ival1 = XCHAR (obj1);
@@ -336,7 +349,7 @@
   }
 #else /* !LISP_FLOAT_TYPE */
   {
-    EMACS_INT ival1, ival2;
+    int ival1, ival2;
 
     if      (INTP    (obj1)) ival1 = XINT  (obj1);
     else if (CHARP   (obj1)) ival1 = XCHAR (obj1);
@@ -365,7 +378,7 @@
 bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
 {
 #ifdef LISP_FLOAT_TYPE
-  EMACS_INT ival1, ival2;
+  int ival1, ival2;
   int float_p;
 
  retry:
@@ -427,7 +440,7 @@
       return make_float (dval1);
     }
 #else /* !LISP_FLOAT_TYPE */
-  EMACS_INT ival1, ival2;
+  int ival1, ival2;
 
  retry:
 
@@ -525,10 +538,6 @@
   }
 
  wrong_number_of_arguments:
-  /* The actual printed compiled_function object is incomprehensible.
-     Check the backtrace to see if we can get a more meaningful symbol. */
-  if (EQ (fun, indirect_function (*backtrace_list->function, 0)))
-    fun = *backtrace_list->function;
   return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs)));
 }
 
@@ -594,12 +603,12 @@
 
 
 static Lisp_Object
-execute_optimized_program (const Opbyte *program,
+execute_optimized_program (CONST Opbyte *program,
 			   int stack_depth,
 			   Lisp_Object *constants_data)
 {
   /* This function can GC */
-  REGISTER const Opbyte *program_ptr = (Opbyte *) program;
+  REGISTER CONST Opbyte *program_ptr = (Opbyte *) program;
   REGISTER Lisp_Object *stack_ptr
     = alloca_array (Lisp_Object, stack_depth + 1);
   int speccount = specpdl_depth ();
@@ -641,7 +650,7 @@
 #ifdef BYTE_CODE_METER
       prev_opcode = this_opcode;
       this_opcode = opcode;
-      meter_code (prev_opcode, this_opcode);
+      METER_CODE (prev_opcode, this_opcode);
 #endif
 
       switch (opcode)
@@ -684,7 +693,7 @@
 	do_varset:
 	{
 	  Lisp_Object symbol = constants_data[n];
-	  Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
+	  struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
 	  Lisp_Object old_value = symbol_ptr->value;
 	  Lisp_Object new_value = POP;
 	  if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
@@ -705,7 +714,7 @@
 	do_varbind:
 	{
 	  Lisp_Object symbol = constants_data[n];
-	  Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
+	  struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
 	  Lisp_Object old_value = symbol_ptr->value;
 	  Lisp_Object new_value = POP;
 	  if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
@@ -758,7 +767,6 @@
 		      opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
 	  break;
 
-
 	case Bgoto:
 	  JUMP;
 	  break;
@@ -996,11 +1004,11 @@
 	  }
 
 	case Bsub1:
-	  TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP);
+	  TOP = INTP (TOP) ? make_int (XINT (TOP) - 1) : Fsub1 (TOP);
 	  break;
 
 	case Badd1:
-	  TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP);
+	  TOP = INTP (TOP) ? make_int (XINT (TOP) + 1) : Fadd1 (TOP);
 	  break;
 
 
@@ -1054,7 +1062,7 @@
 	    Lisp_Object arg2 = POP;
 	    Lisp_Object arg1 = TOP;
 	    TOP = INTP (arg1) && INTP (arg2) ?
-	      INT_PLUS (arg1, arg2) :
+	      make_int (XINT (arg1) + XINT (arg2)) :
 	      bytecode_arithop (arg1, arg2, opcode);
 	    break;
 	  }
@@ -1064,7 +1072,7 @@
 	    Lisp_Object arg2 = POP;
 	    Lisp_Object arg1 = TOP;
 	    TOP = INTP (arg1) && INTP (arg2) ?
-	      INT_MINUS (arg1, arg2) :
+	      make_int (XINT (arg1) - XINT (arg2)) :
 	      bytecode_arithop (arg1, arg2, opcode);
 	    break;
 	  }
@@ -1107,6 +1115,7 @@
 	    break;
 	  }
 
+
 	case Bset:
 	  {
 	    Lisp_Object arg = POP;
@@ -1219,7 +1228,7 @@
    Don't make this function static, since then the compiler might inline it. */
 Lisp_Object *
 execute_rare_opcode (Lisp_Object *stack_ptr,
-		     const Opbyte *program_ptr,
+		     CONST Opbyte *program_ptr,
 		     Opcode opcode)
 {
   switch (opcode)
@@ -1489,7 +1498,7 @@
 
   sprintf (buf, "%s", error_message);
   va_start (args, error_message);
-  obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (buf), Qnil, -1,
+  obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (buf), Qnil, -1,
 				args);
   va_end (args);
 
@@ -1605,14 +1614,14 @@
 		    Lisp_Object instructions,
 		    Lisp_Object constants,
 		    /* out */
-		    Opbyte * const program,
-		    int * const program_length,
-		    int * const varbind_count)
+		    Opbyte * CONST program,
+		    int * CONST program_length,
+		    int * CONST varbind_count)
 {
   size_t instructions_length = XSTRING_LENGTH (instructions);
   size_t comfy_size = 2 * instructions_length;
 
-  int * const icounts = alloca_array (int, comfy_size);
+  int * CONST icounts = alloca_array (int, comfy_size);
   int * icounts_ptr = icounts;
 
   /* We maintain a table of jumps in the source code. */
@@ -1621,13 +1630,13 @@
     int from;
     int to;
   };
-  struct jump * const jumps = alloca_array (struct jump, comfy_size);
+  struct jump * CONST jumps = alloca_array (struct jump, comfy_size);
   struct jump *jumps_ptr = jumps;
 
   Opbyte *program_ptr = program;
 
-  const Bufbyte *ptr = XSTRING_DATA (instructions);
-  const Bufbyte * const end = ptr + instructions_length;
+  CONST Bufbyte *ptr = XSTRING_DATA (instructions);
+  CONST Bufbyte * CONST end = ptr + instructions_length;
 
   *varbind_count = 0;
 
@@ -1892,7 +1901,8 @@
 			  program, &program_length, &varbind_count);
       f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
       f->instructions =
-	make_opaque (program, program_length * sizeof (Opbyte));
+	Fpurecopy (make_opaque (program_length * sizeof (Opbyte),
+				(CONST void *) program));
     }
 
   assert (OPAQUEP (f->instructions));
@@ -1978,15 +1988,15 @@
 
 
 static Lisp_Object
-mark_compiled_function (Lisp_Object obj)
+mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
   Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
 
-  mark_object (f->instructions);
-  mark_object (f->arglist);
-  mark_object (f->doc_and_interactive);
+  markobj (f->instructions);
+  markobj (f->arglist);
+  markobj (f->doc_and_interactive);
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
-  mark_object (f->annotated);
+  markobj (f->annotated);
 #endif
   /* tail-recurse on constants */
   return f->constants;
@@ -2020,23 +2030,11 @@
 		internal_hash (f->constants,    depth + 1));
 }
 
-static const struct lrecord_description compiled_function_description[] = {
-  { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
-  { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
-  { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
-  { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) },
-#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
-  { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
-#endif
-  { XD_END }
-};
-
 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
 				     mark_compiled_function,
 				     print_compiled_function, 0,
 				     compiled_function_equal,
 				     compiled_function_hash,
-				     compiled_function_description,
 				     Lisp_Compiled_Function);
 
 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
@@ -2067,13 +2065,13 @@
     /* Invert action performed by optimize_byte_code() */
     Lisp_Opaque *opaque = XOPAQUE (f->instructions);
 
-    Bufbyte * const buffer =
+    Bufbyte * CONST buffer =
       alloca_array (Bufbyte, OPAQUE_SIZE (opaque) * MAX_EMCHAR_LEN);
     Bufbyte *bp = buffer;
 
-    const Opbyte * const program = (const Opbyte *) OPAQUE_DATA (opaque);
-    const Opbyte *program_ptr = program;
-    const Opbyte * const program_end = program_ptr + OPAQUE_SIZE (opaque);
+    CONST Opbyte * CONST program = (CONST Opbyte *) OPAQUE_DATA (opaque);
+    CONST Opbyte *program_ptr = program;
+    CONST Opbyte * CONST program_end = program_ptr + OPAQUE_SIZE (opaque);
 
     while (program_ptr < program_end)
       {
@@ -2350,8 +2348,10 @@
       /* v18 or v19 bytecode file.  Need to Ebolify. */
       if (f->flags.ebolified && VECTORP (XCDR (tem)))
 	ebolify_bytecode_constants (XCDR (tem));
-      f->instructions = XCAR (tem);
-      f->constants    = XCDR (tem);
+      /* VERY IMPORTANT to purecopy here!!!!!
+	 See load_force_doc_string_unwind. */
+      f->instructions = Fpurecopy (XCAR (tem));
+      f->constants    = Fpurecopy (XCDR (tem));
       return function;
     }
   abort ();
@@ -2408,8 +2408,6 @@
 void
 syms_of_bytecode (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (compiled_function);
-
   deferror (&Qinvalid_byte_code, "invalid-byte-code",
 	    "Invalid byte code", Qerror);
   defsymbol (&Qbyte_code, "byte-code");