X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/11af46027d22daa11d0df7d5032e6925c990dad1..0a2aedfe6d650e825a50f25f972bac20d669f5cb:/src/bytecode.c diff --git a/src/bytecode.c b/src/bytecode.c index d3c8b470cc..c9e4a25dfa 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,13 +1,13 @@ /* Execution of byte code produced by bytecomp.el. - Copyright (C) 1985-1988, 1993, 2000-2014 Free Software Foundation, + Copyright (C) 1985-1988, 1993, 2000-2016 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -69,7 +69,6 @@ by Hallvard: #ifdef BYTE_CODE_METER -Lisp_Object Qbyte_code_meter; #define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2) #define METER_1(code) METER_2 (0, code) @@ -297,7 +296,7 @@ enum byte_code_op }; /* Whether to maintain a `top' and `bottom' field in the stack frame. */ -#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK) +#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE /* Structure describing a value stack used during byte-code execution in Fbyte_code. */ @@ -320,12 +319,6 @@ struct byte_stack Lisp_Object byte_string; const unsigned char *byte_string_start; -#if BYTE_MARK_STACK - /* The vector of constants used during byte-code execution. Storing - this here protects it from GC because mark_byte_stack marks it. */ - Lisp_Object constants; -#endif - /* Next entry in byte_stack_list. */ struct byte_stack *next; }; @@ -333,46 +326,16 @@ struct byte_stack /* A list of currently active byte-code execution value stacks. Fbyte_code adds an entry to the head of this list before it starts processing byte-code, and it removes the entry again when it is - done. Signaling an error truncates the list analogous to - gcprolist. */ + done. Signaling an error truncates the list. */ struct byte_stack *byte_stack_list; -/* Mark objects on byte_stack_list. Called during GC. */ +/* Relocate program counters in the stacks on byte_stack_list. Called + when GC has completed. */ -#if BYTE_MARK_STACK void -mark_byte_stack (void) -{ - struct byte_stack *stack; - Lisp_Object *obj; - - for (stack = byte_stack_list; stack; stack = stack->next) - { - /* If STACK->top is null here, this means there's an opcode in - Fbyte_code that wasn't expected to GC, but did. To find out - which opcode this is, record the value of `stack', and walk - up the stack in a debugger, stopping in frames of Fbyte_code. - The culprit is found in the frame of Fbyte_code where the - address of its local variable `stack' is equal to the - recorded value of `stack' here. */ - eassert (stack->top); - - for (obj = stack->bottom; obj <= stack->top; ++obj) - mark_object (*obj); - - mark_object (stack->byte_string); - mark_object (stack->constants); - } -} -#endif - -/* Unmark objects in the stacks on byte_stack_list. Relocate program - counters. Called when GC has completed. */ - -void -unmark_byte_stack (void) +relocate_byte_stack (void) { struct byte_stack *stack; @@ -555,9 +518,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, stack.byte_string = bytestr; stack.pc = stack.byte_string_start = SDATA (bytestr); -#if BYTE_MARK_STACK - stack.constants = vector; -#endif if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth)) memory_full (SIZE_MAX); top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top); @@ -677,7 +637,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, the table clearer. */ #define LABEL(OP) [OP] = &&insn_ ## OP -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) +#if GNUC_PREREQ (4, 6, 0) # pragma GCC diagnostic push # pragma GCC diagnostic ignored "-Woverride-init" #elif defined __clang__ @@ -696,7 +656,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #undef DEFINE }; -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) || defined __clang__ +#if GNUC_PREREQ (4, 6, 0) || defined __clang__ # pragma GCC diagnostic pop #endif @@ -1107,17 +1067,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, type = CATCHER; goto pushhandler; CASE (Bpushconditioncase): /* New in 24.4. */ + type = CONDITION_CASE; + pushhandler: { - struct handler *c; - Lisp_Object tag; - int dest; - - type = CONDITION_CASE; - pushhandler: - tag = POP; - dest = FETCH2; + Lisp_Object tag = POP; + int dest = FETCH2; - PUSH_HANDLER (c, tag, type); + struct handler *c = push_handler (tag, type); c->bytecode_dest = dest; c->bytecode_top = top; @@ -1946,10 +1902,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ /* CASE (Bstack_ref): */ - call3 (intern ("error"), - build_string ("Invalid byte opcode: op=%s, ptr=%d"), - make_number (op), - make_number ((stack.pc - 1) - stack.byte_string_start)); + call3 (Qerror, + build_string ("Invalid byte opcode: op=%s, ptr=%d"), + make_number (op), + make_number ((stack.pc - 1) - stack.byte_string_start)); /* Handy byte-codes for lexical binding. */ CASE (Bstack_ref1): @@ -2031,6 +1987,20 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, return result; } +/* `args_template' has the same meaning as in exec_byte_code() above. */ +Lisp_Object +get_byte_code_arity (Lisp_Object args_template) +{ + eassert (NATNUMP (args_template)); + EMACS_INT at = XINT (args_template); + bool rest = (at & 128) != 0; + int mandatory = at & 127; + EMACS_INT nonrest = at >> 8; + + return Fcons (make_number (mandatory), + rest ? Qmany : make_number (nonrest)); +} + void syms_of_bytecode (void) {