#include "opaque.h"
#include "syntax.h"
-#include <limits.h>
-
EXFUN (Ffetch_bytecode, 1);
Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
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,
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);
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;
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
}
default:
- abort();
+ ABORT();
break;
}
return stack_ptr;
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;
break;
default:
- abort();
+ ABORT();
break;
}
}
/* *program_ptr++ = 0; */
*program_length = program_ptr - program;
+ xfree(jumps);
}
/* Optimize the byte code and store the optimized program, only
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));
}
}
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))
{
f->constants = XCDR (tem);
return function;
}
- abort ();
+ ABORT ();
return Qnil; /* not reached */
}
void
syms_of_bytecode (void)
{
- deferror (&Qinvalid_byte_code, "invalid-byte-code",
- "Invalid byte code", Qerror);
+ INIT_LRECORD_IMPLEMENTATION (compiled_function);
+
+ DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
defsymbol (&Qbyte_code, "byte-code");
defsymbol (&Qcompiled_functionp, "compiled-function-p");