X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fbytecode.c;h=5bbb326db2446a149258ad5f31742dabe29e2ba2;hp=23f0b9f89061a7a30325e7b6dce7da8434426d74;hb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;hpb=a71e0987b7080176e0046b0b0ed72a9a70e2571d diff --git a/src/bytecode.c b/src/bytecode.c index 23f0b9f..5bbb326 100644 --- 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 @@ -56,9 +56,6 @@ by Hallvard: #include "opaque.h" #include "syntax.h" -#include -#include - EXFUN (Ffetch_bytecode, 1); Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code; @@ -217,10 +214,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); @@ -236,21 +233,17 @@ extern Lisp_Object Qand_rest, Qand_optional; Lisp_Object Vbyte_code_meter, Qbyte_code_meter; int byte_metering_on; -#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<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; @@ -532,6 +526,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))); } @@ -597,12 +595,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 (); @@ -644,7 +642,7 @@ execute_optimized_program (CONST Opbyte *program, #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) @@ -687,7 +685,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)) @@ -708,7 +706,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)) @@ -761,6 +759,7 @@ execute_optimized_program (CONST Opbyte *program, opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2)); break; + case Bgoto: JUMP; break; @@ -998,11 +997,11 @@ execute_optimized_program (CONST Opbyte *program, } case Bsub1: - TOP = INTP (TOP) ? make_int (XINT (TOP) - 1) : Fsub1 (TOP); + TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP); break; case Badd1: - TOP = INTP (TOP) ? make_int (XINT (TOP) + 1) : Fadd1 (TOP); + TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP); break; @@ -1056,7 +1055,7 @@ execute_optimized_program (CONST Opbyte *program, Lisp_Object arg2 = POP; Lisp_Object arg1 = TOP; TOP = INTP (arg1) && INTP (arg2) ? - make_int (XINT (arg1) + XINT (arg2)) : + INT_PLUS (arg1, arg2) : bytecode_arithop (arg1, arg2, opcode); break; } @@ -1066,7 +1065,7 @@ execute_optimized_program (CONST Opbyte *program, Lisp_Object arg2 = POP; Lisp_Object arg1 = TOP; TOP = INTP (arg1) && INTP (arg2) ? - make_int (XINT (arg1) - XINT (arg2)) : + INT_MINUS (arg1, arg2) : bytecode_arithop (arg1, arg2, opcode); break; } @@ -1109,7 +1108,6 @@ execute_optimized_program (CONST Opbyte *program, break; } - case Bset: { Lisp_Object arg = POP; @@ -1222,7 +1220,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) @@ -1492,7 +1490,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); @@ -1608,14 +1606,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. */ @@ -1624,13 +1622,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; @@ -1895,8 +1893,7 @@ optimize_compiled_function (Lisp_Object compiled_function) program, &program_length, &varbind_count); f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count; f->instructions = - Fpurecopy (make_opaque (program_length * sizeof (Opbyte), - (CONST void *) program)); + make_opaque (program, program_length * sizeof (Opbyte)); } assert (OPAQUEP (f->instructions)); @@ -1982,15 +1979,15 @@ print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun, static Lisp_Object -mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_compiled_function (Lisp_Object obj) { Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj); - markobj (f->instructions); - markobj (f->arglist); - markobj (f->doc_and_interactive); + mark_object (f->instructions); + mark_object (f->arglist); + mark_object (f->doc_and_interactive); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK - markobj (f->annotated); + mark_object (f->annotated); #endif /* tail-recurse on constants */ return f->constants; @@ -2025,9 +2022,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 } }; @@ -2068,13 +2068,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) { @@ -2351,10 +2351,8 @@ If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now. /* v18 or v19 bytecode file. Need to Ebolify. */ if (f->flags.ebolified && VECTORP (XCDR (tem))) ebolify_bytecode_constants (XCDR (tem)); - /* VERY IMPORTANT to purecopy here!!!!! - See load_force_doc_string_unwind. */ - f->instructions = Fpurecopy (XCAR (tem)); - f->constants = Fpurecopy (XCDR (tem)); + f->instructions = XCAR (tem); + f->constants = XCDR (tem); return function; } abort (); @@ -2411,8 +2409,9 @@ If STACK-DEPTH is incorrect, Emacs may crash. 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");