XEmacs 21.4.20 "Double Solitaire".

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

diff --git a/src/bytecode.c b/src/bytecode.c
index b31bc4c..72f5d62 100644 (file)
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -211,6 +211,7 @@ typedef enum Opcode Opcode;
 typedef unsigned char Opbyte;
 \f
 
+static void check_opcode (Opcode opcode);
 static void invalid_byte_code_error (char *error_message, ...);
 
 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
@@ -471,7 +472,6 @@ Lisp_Object
 funcall_compiled_function (Lisp_Object fun, int nargs, Lisp_Object args[])
 {
   /* This function can GC */
-  Lisp_Object symbol, tail;
   int speccount = specpdl_depth();
   REGISTER int i = 0;
   Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
@@ -486,24 +486,26 @@ funcall_compiled_function (Lisp_Object fun, int nargs, Lisp_Object args[])
      and local variables of fun.   So just reserve it once. */
   SPECPDL_RESERVE (f->specpdl_depth);
 
-  /* Fmake_byte_code() guaranteed that f->arglist is a valid list
-     containing only non-constant symbols. */
-  LIST_LOOP_3 (symbol, f->arglist, tail)
-    {
-      if (EQ (symbol, Qand_rest))
-       {
-         tail = XCDR (tail);
-         symbol  = XCAR (tail);
-         SPECBIND_FAST_UNSAFE (symbol, Flist (nargs - i, &args[i]));
-         goto run_code;
-       }
-      else if (EQ (symbol, Qand_optional))
-       optional = 1;
-      else if (i == nargs && !optional)
-       goto wrong_number_of_arguments;
-      else
-       SPECBIND_FAST_UNSAFE (symbol, i < nargs ? args[i++] : Qnil);
-    }
+  {
+    /* Fmake_byte_code() guaranteed that f->arglist is a valid list
+       containing only non-constant symbols. */
+    LIST_LOOP_3 (symbol, f->arglist, tail)
+      {
+       if (EQ (symbol, Qand_rest))
+         {
+           tail = XCDR (tail);
+           symbol  = XCAR (tail);
+           SPECBIND_FAST_UNSAFE (symbol, Flist (nargs - i, &args[i]));
+           goto run_code;
+         }
+       else if (EQ (symbol, Qand_optional))
+         optional = 1;
+       else if (i == nargs && !optional)
+         goto wrong_number_of_arguments;
+       else
+         SPECBIND_FAST_UNSAFE (symbol, i < nargs ? args[i++] : Qnil);
+      }
+  }
 
   if (i < nargs)
     goto wrong_number_of_arguments;
@@ -636,6 +638,7 @@ execute_optimized_program (const Opbyte *program,
        invalid_byte_code_error ("byte code stack overflow");
       if (stack_ptr < stack_beg)
        invalid_byte_code_error ("byte code stack underflow");
+      check_opcode (opcode);
 #endif
 
 #ifdef BYTE_CODE_METER
@@ -1473,7 +1476,7 @@ execute_rare_opcode (Lisp_Object *stack_ptr,
       }
 
     default:
-      abort();
+      ABORT();
       break;
     }
   return stack_ptr;
@@ -1621,7 +1624,7 @@ optimize_byte_code (/* in */
     int from;
     int to;
   };
-  struct jump * const jumps = alloca_array (struct jump, comfy_size);
+  struct jump * const jumps = xnew_array (struct jump, comfy_size);
   struct jump *jumps_ptr = jumps;
 
   Opbyte *program_ptr = program;
@@ -1856,7 +1859,7 @@ optimize_byte_code (/* in */
                break;
 
            default:
-             abort();
+             ABORT();
              break;
            }
        }
@@ -1865,6 +1868,7 @@ optimize_byte_code (/* in */
 
   /* *program_ptr++ = 0; */
   *program_length = program_ptr - program;
+  xfree(jumps);
 }
 
 /* Optimize the byte code and store the optimized program, only
@@ -1890,7 +1894,8 @@ optimize_compiled_function (Lisp_Object compiled_function)
       program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions));
       optimize_byte_code (f->instructions, f->constants,
                          program, &program_length, &varbind_count);
-      f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
+      f->specpdl_depth = (unsigned short) (XINT (Flength (f->arglist)) +
+                                           varbind_count);
       f->instructions =
        make_opaque (program, program_length * sizeof (Opbyte));
     }
@@ -2263,7 +2268,7 @@ Return the constants vector of the compiled-function object FUNCTION.
 }
 
 DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /*
-Return the max stack depth of the compiled-function object FUNCTION.
+Return the maximum stack depth of the compiled-function object FUNCTION.
 */
        (function))
 {
@@ -2354,7 +2359,7 @@ If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now.
       f->constants    = XCDR (tem);
       return function;
     }
-  abort ();
+  ABORT ();
   return Qnil; /* not reached */
 }
 
@@ -2410,8 +2415,7 @@ syms_of_bytecode (void)
 {
   INIT_LRECORD_IMPLEMENTATION (compiled_function);
 
-  deferror (&Qinvalid_byte_code, "invalid-byte-code",
-           "Invalid byte code", Qerror);
+  DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
   defsymbol (&Qbyte_code, "byte-code");
   defsymbol (&Qcompiled_functionp, "compiled-function-p");