aboutsummaryrefslogtreecommitdiffstats
path: root/src/bytecode.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bytecode.c')
-rw-r--r--src/bytecode.c96
1 files changed, 81 insertions, 15 deletions
diff --git a/src/bytecode.c b/src/bytecode.c
index 3ac8b452fbe..ca6681f21e9 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1,5 +1,5 @@
1/* Execution of byte code produced by bytecomp.el. 1/* Execution of byte code produced by bytecomp.el.
2 Copyright (C) 1985-1988, 1993, 2000-2013 Free Software Foundation, 2 Copyright (C) 1985-1988, 1993, 2000-2014 Free Software Foundation,
3 Inc. 3 Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
@@ -141,6 +141,10 @@ DEFINE (Bunbind5, 055) \
141DEFINE (Bunbind6, 056) \ 141DEFINE (Bunbind6, 056) \
142DEFINE (Bunbind7, 057) \ 142DEFINE (Bunbind7, 057) \
143 \ 143 \
144DEFINE (Bpophandler, 060) \
145DEFINE (Bpushconditioncase, 061) \
146DEFINE (Bpushcatch, 062) \
147 \
144DEFINE (Bnth, 070) \ 148DEFINE (Bnth, 070) \
145DEFINE (Bsymbolp, 071) \ 149DEFINE (Bsymbolp, 071) \
146DEFINE (Bconsp, 072) \ 150DEFINE (Bconsp, 072) \
@@ -288,8 +292,6 @@ enum byte_code_op
288 Bscan_buffer = 0153, /* No longer generated as of v18. */ 292 Bscan_buffer = 0153, /* No longer generated as of v18. */
289 Bset_mark = 0163, /* this loser is no longer generated as of v18 */ 293 Bset_mark = 0163, /* this loser is no longer generated as of v18 */
290#endif 294#endif
291
292 B__dummy__ = 0 /* Pacify C89. */
293}; 295};
294 296
295/* Whether to maintain a `top' and `bottom' field in the stack frame. */ 297/* Whether to maintain a `top' and `bottom' field in the stack frame. */
@@ -328,7 +330,7 @@ struct byte_stack
328 330
329/* A list of currently active byte-code execution value stacks. 331/* A list of currently active byte-code execution value stacks.
330 Fbyte_code adds an entry to the head of this list before it starts 332 Fbyte_code adds an entry to the head of this list before it starts
331 processing byte-code, and it removed the entry again when it is 333 processing byte-code, and it removes the entry again when it is
332 done. Signaling an error truncates the list analogous to 334 done. Signaling an error truncates the list analogous to
333 gcprolist. */ 335 gcprolist. */
334 336
@@ -386,7 +388,11 @@ unmark_byte_stack (void)
386 388
387/* Fetch the next byte from the bytecode stream. */ 389/* Fetch the next byte from the bytecode stream. */
388 390
391#ifdef BYTE_CODE_SAFE
392#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++)
393#else
389#define FETCH *stack.pc++ 394#define FETCH *stack.pc++
395#endif
390 396
391/* Fetch two bytes from the bytecode stream and make a 16-bit number 397/* Fetch two bytes from the bytecode stream and make a 16-bit number
392 out of them. */ 398 out of them. */
@@ -478,6 +484,12 @@ If the third argument is incorrect, Emacs may crash. */)
478 return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); 484 return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
479} 485}
480 486
487static void
488bcall0 (Lisp_Object f)
489{
490 Ffuncall (1, &f);
491}
492
481/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and 493/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and
482 MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, 494 MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
483 emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp 495 emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp
@@ -492,7 +504,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
492{ 504{
493 ptrdiff_t count = SPECPDL_INDEX (); 505 ptrdiff_t count = SPECPDL_INDEX ();
494#ifdef BYTE_CODE_METER 506#ifdef BYTE_CODE_METER
495 int this_op = 0; 507 int volatile this_op = 0;
496 int prev_op; 508 int prev_op;
497#endif 509#endif
498 int op; 510 int op;
@@ -506,6 +518,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
506 struct byte_stack stack; 518 struct byte_stack stack;
507 Lisp_Object *top; 519 Lisp_Object *top;
508 Lisp_Object result; 520 Lisp_Object result;
521 enum handlertype type;
509 522
510#if 0 /* CHECK_FRAME_FONT */ 523#if 0 /* CHECK_FRAME_FONT */
511 { 524 {
@@ -1078,7 +1091,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1078 save_restriction_save ()); 1091 save_restriction_save ());
1079 NEXT; 1092 NEXT;
1080 1093
1081 CASE (Bcatch): /* FIXME: ill-suited for lexbind. */ 1094 CASE (Bcatch): /* Obsolete since 24.4. */
1082 { 1095 {
1083 Lisp_Object v1; 1096 Lisp_Object v1;
1084 BEFORE_POTENTIAL_GC (); 1097 BEFORE_POTENTIAL_GC ();
@@ -1088,11 +1101,61 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1088 NEXT; 1101 NEXT;
1089 } 1102 }
1090 1103
1104 CASE (Bpushcatch): /* New in 24.4. */
1105 type = CATCHER;
1106 goto pushhandler;
1107 CASE (Bpushconditioncase): /* New in 24.4. */
1108 {
1109 extern EMACS_INT lisp_eval_depth;
1110 extern int poll_suppress_count;
1111 extern int interrupt_input_blocked;
1112 struct handler *c;
1113 Lisp_Object tag;
1114 int dest;
1115
1116 type = CONDITION_CASE;
1117 pushhandler:
1118 tag = POP;
1119 dest = FETCH2;
1120
1121 PUSH_HANDLER (c, tag, type);
1122 c->bytecode_dest = dest;
1123 c->bytecode_top = top;
1124
1125 if (sys_setjmp (c->jmp))
1126 {
1127 struct handler *c = handlerlist;
1128 int dest;
1129 top = c->bytecode_top;
1130 dest = c->bytecode_dest;
1131 handlerlist = c->next;
1132 PUSH (c->val);
1133 CHECK_RANGE (dest);
1134 /* Might have been re-set by longjmp! */
1135 stack.byte_string_start = SDATA (stack.byte_string);
1136 stack.pc = stack.byte_string_start + dest;
1137 }
1138
1139 NEXT;
1140 }
1141
1142 CASE (Bpophandler): /* New in 24.4. */
1143 {
1144 handlerlist = handlerlist->next;
1145 NEXT;
1146 }
1147
1091 CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */ 1148 CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
1092 record_unwind_protect (unwind_body, POP); 1149 {
1093 NEXT; 1150 Lisp_Object handler = POP;
1151 /* Support for a function here is new in 24.4. */
1152 record_unwind_protect (NILP (Ffunctionp (handler))
1153 ? unwind_body : bcall0,
1154 handler);
1155 NEXT;
1156 }
1094 1157
1095 CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */ 1158 CASE (Bcondition_case): /* Obsolete since 24.4. */
1096 { 1159 {
1097 Lisp_Object handlers, body; 1160 Lisp_Object handlers, body;
1098 handlers = POP; 1161 handlers = POP;
@@ -1884,7 +1947,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1884 /* Actually this is Bstack_ref with offset 0, but we use Bdup 1947 /* Actually this is Bstack_ref with offset 0, but we use Bdup
1885 for that instead. */ 1948 for that instead. */
1886 /* CASE (Bstack_ref): */ 1949 /* CASE (Bstack_ref): */
1887 error ("Invalid byte opcode"); 1950 call3 (intern ("error"),
1951 build_string ("Invalid byte opcode: op=%s, ptr=%d"),
1952 make_number (op),
1953 make_number ((stack.pc - 1) - stack.byte_string_start));
1888 1954
1889 /* Handy byte-codes for lexical binding. */ 1955 /* Handy byte-codes for lexical binding. */
1890 CASE (Bstack_ref1): 1956 CASE (Bstack_ref1):
@@ -1957,11 +2023,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1957 2023
1958 /* Binds and unbinds are supposed to be compiled balanced. */ 2024 /* Binds and unbinds are supposed to be compiled balanced. */
1959 if (SPECPDL_INDEX () != count) 2025 if (SPECPDL_INDEX () != count)
1960#ifdef BYTE_CODE_SAFE 2026 {
1961 error ("binding stack not balanced (serious byte compiler bug)"); 2027 if (SPECPDL_INDEX () > count)
1962#else 2028 unbind_to (count, Qnil);
1963 emacs_abort (); 2029 error ("binding stack not balanced (serious byte compiler bug)");
1964#endif 2030 }
1965 2031
1966 return result; 2032 return result;
1967} 2033}