X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fbytecode.c;h=8a685ab4f61c92fcc0f48bfa89f9135e8bb1d87e;hp=b5111d1eb031d1dd4cb2aac6f151dc560691b05e;hb=ea1ea793fe6e244ef5555ed983423a204101af13;hpb=77dcef404dc78635f6ffa8f71a803d2bc7cc8921 diff --git a/src/bytecode.c b/src/bytecode.c index b5111d1..8a685ab 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -56,7 +56,6 @@ by Hallvard: #include "opaque.h" #include "syntax.h" -#include #include EXFUN (Ffetch_bytecode, 1); @@ -226,12 +225,6 @@ static Lisp_Object execute_optimized_program (CONST Opbyte *program, 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 */ @@ -242,21 +235,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<stack_depth, XVECTOR_DATA (f->constants)); - UNBIND_TO_GCPRO_VARIABLES_ONLY (speccount, value); + /* The attempt to optimize this by only unbinding variables failed + because using buffer-local variables as function parameters + leads to specpdl_ptr->func != 0 */ + /* UNBIND_TO_GCPRO_VARIABLES_ONLY (speccount, value); */ + UNBIND_TO_GCPRO (speccount, value); return value; } @@ -646,7 +639,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) @@ -763,6 +756,7 @@ execute_optimized_program (CONST Opbyte *program, opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2)); break; + case Bgoto: JUMP; break; @@ -1000,11 +994,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; @@ -1058,7 +1052,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; } @@ -1068,7 +1062,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; } @@ -1111,7 +1105,6 @@ execute_optimized_program (CONST Opbyte *program, break; } - case Bset: { Lisp_Object arg = POP; @@ -1897,8 +1890,8 @@ 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_length * sizeof (Opbyte), + (CONST void *) program); } assert (OPAQUEP (f->instructions)); @@ -1984,15 +1977,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; @@ -2026,11 +2019,20 @@ compiled_function_hash (Lisp_Object obj, int depth) internal_hash (f->constants, depth + 1)); } +static const struct lrecord_description compiled_function_description[] = { + { XD_LISP_OBJECT, offsetof(struct Lisp_Compiled_Function, instructions), 4 }, +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK + { XD_LISP_OBJECT, offsetof(struct Lisp_Compiled_Function, annotated), 1 }, +#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, /* @@ -2336,7 +2338,7 @@ If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now. if (OPAQUEP (f->instructions) || STRINGP (f->instructions)) return function; - if (CONSP (XCOMPILED_FUNCTION (function)->instructions)) + if (CONSP (f->instructions)) { Lisp_Object tem = read_doc_string (f->instructions); if (!CONSP (tem)) @@ -2344,10 +2346,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 ();