This commit was generated by cvs2svn to compensate for changes in r1383,

[chise/xemacs-chise.git.1] / src / bytecode.c

diff --git a/src/bytecode.c b/src/bytecode.c
index 8a685ab..b0ff4e0 100644 (file)
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -28,7 +28,7 @@ Boston, MA 02111-1307, USA.  */
 
    FSF: long ago.
 
-hacked on by jwz@netscape.com 1991-06
+hacked on by jwz@jwz.org 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
@@ -216,10 +216,10 @@ typedef unsigned char Opbyte;
 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);
 
@@ -527,6 +527,10 @@ funcall_compiled_function (Lisp_Object fun, int nargs, Lisp_Object args[])
   }
 
  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)));
 }
 
@@ -592,12 +596,12 @@ funcall_compiled_function (Lisp_Object fun, int nargs, Lisp_Object args[])
 
 
 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 ();
@@ -682,7 +686,7 @@ execute_optimized_program (CONST Opbyte *program,
        do_varset:
        {
          Lisp_Object symbol = constants_data[n];
-         struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
+         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))
@@ -703,7 +707,7 @@ execute_optimized_program (CONST Opbyte *program,
        do_varbind:
        {
          Lisp_Object symbol = constants_data[n];
-         struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
+         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))
@@ -1217,7 +1221,7 @@ execute_optimized_program (CONST Opbyte *program,
    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)
@@ -1487,7 +1491,7 @@ invalid_byte_code_error (char *error_message, ...)
 
   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);
 
@@ -1603,14 +1607,14 @@ optimize_byte_code (/* in */
                    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. */
@@ -1619,13 +1623,13 @@ optimize_byte_code (/* in */
     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;
 
@@ -1890,8 +1894,7 @@ optimize_compiled_function (Lisp_Object compiled_function)
                          program, &program_length, &varbind_count);
       f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
       f->instructions =
-       make_opaque (program_length * sizeof (Opbyte),
-                    (CONST void *) program);
+       make_opaque (program, program_length * sizeof (Opbyte));
     }
 
   assert (OPAQUEP (f->instructions));
@@ -2020,9 +2023,12 @@ compiled_function_hash (Lisp_Object obj, int depth)
 }
 
 static const struct lrecord_description compiled_function_description[] = {
-  { XD_LISP_OBJECT, offsetof(struct Lisp_Compiled_Function, instructions), 4 },
+  { 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(struct Lisp_Compiled_Function, annotated), 1 },
+  { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
 #endif
   { XD_END }
 };
@@ -2063,13 +2069,13 @@ compiled_function_instructions (Lisp_Compiled_Function *f)
     /* 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)
       {
@@ -2404,6 +2410,8 @@ If STACK-DEPTH is incorrect, Emacs may crash.
 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");