aboutsummaryrefslogtreecommitdiffstats
path: root/src/bytecode.c
diff options
context:
space:
mode:
authorAlan Mackenzie2016-12-11 16:23:17 +0000
committerAlan Mackenzie2016-12-11 16:23:17 +0000
commitde077da39da7d143f904d6405b62919e5f3e72d6 (patch)
tree103a323d6f57b96ce36180ecc2cdca3a7bc8fe9d /src/bytecode.c
parent3ec37548b595b3481fd19f82b121d82e6e8f43a5 (diff)
parentfc0fd24c105bde4c001ebebe4b8b7e1f96cd2871 (diff)
downloademacs-de077da39da7d143f904d6405b62919e5f3e72d6.tar.gz
emacs-de077da39da7d143f904d6405b62919e5f3e72d6.zip
Merge branch 'master' into comment-cache
Diffstat (limited to 'src/bytecode.c')
-rw-r--r--src/bytecode.c1003
1 files changed, 233 insertions, 770 deletions
diff --git a/src/bytecode.c b/src/bytecode.c
index 9ae2e820d51..71ecdbf2cc0 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -17,22 +17,6 @@ GNU General Public License for more details.
17You should have received a copy of the GNU General Public License 17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 19
20/*
21hacked on by jwz@lucid.com 17-jun-91
22 o added a compile-time switch to turn on simple sanity checking;
23 o put back the obsolete byte-codes for error-detection;
24 o added a new instruction, unbind_all, which I will use for
25 tail-recursion elimination;
26 o made temp_output_buffer_show be called with the right number
27 of args;
28 o made the new bytecodes be called with args in the right order;
29 o added metering support.
30
31by Hallvard:
32 o added relative jump instructions;
33 o all conditionals now only do QUIT if they jump.
34 */
35
36#include <config.h> 20#include <config.h>
37 21
38#include "lisp.h" 22#include "lisp.h"
@@ -43,33 +27,35 @@ by Hallvard:
43#include "syntax.h" 27#include "syntax.h"
44#include "window.h" 28#include "window.h"
45 29
46#ifdef CHECK_FRAME_FONT 30/* Work around GCC bug 54561. */
47#include "frame.h" 31#if GNUC_PREREQ (4, 3, 0)
48#include "xterm.h" 32# pragma GCC diagnostic ignored "-Wclobbered"
33#endif
34
35/* Define BYTE_CODE_SAFE true to enable some minor sanity checking,
36 useful for debugging the byte compiler. It defaults to false. */
37
38#ifndef BYTE_CODE_SAFE
39# define BYTE_CODE_SAFE false
49#endif 40#endif
50 41
51/* 42/* Define BYTE_CODE_METER to generate a byte-op usage histogram. */
52 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
53 * debugging the byte compiler...)
54 *
55 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
56 */
57/* #define BYTE_CODE_SAFE */
58/* #define BYTE_CODE_METER */ 43/* #define BYTE_CODE_METER */
59 44
60/* If BYTE_CODE_THREADED is defined, then the interpreter will be 45/* If BYTE_CODE_THREADED is defined, then the interpreter will be
61 indirect threaded, using GCC's computed goto extension. This code, 46 indirect threaded, using GCC's computed goto extension. This code,
62 as currently implemented, is incompatible with BYTE_CODE_SAFE and 47 as currently implemented, is incompatible with BYTE_CODE_SAFE and
63 BYTE_CODE_METER. */ 48 BYTE_CODE_METER. */
64#if (defined __GNUC__ && !defined __STRICT_ANSI__ \ 49#if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \
65 && !defined BYTE_CODE_SAFE && !defined BYTE_CODE_METER) 50 && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
66#define BYTE_CODE_THREADED 51#define BYTE_CODE_THREADED
67#endif 52#endif
68 53
69 54
70#ifdef BYTE_CODE_METER 55#ifdef BYTE_CODE_METER
71 56
72#define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2) 57#define METER_2(code1, code2) \
58 (*aref_addr (AREF (Vbyte_code_meter, code1), code2))
73#define METER_1(code) METER_2 (0, code) 59#define METER_1(code) METER_2 (0, code)
74 60
75#define METER_CODE(last_code, this_code) \ 61#define METER_CODE(last_code, this_code) \
@@ -289,87 +275,25 @@ enum byte_code_op
289 BYTE_CODES 275 BYTE_CODES
290#undef DEFINE 276#undef DEFINE
291 277
292#ifdef BYTE_CODE_SAFE 278#if BYTE_CODE_SAFE
293 Bscan_buffer = 0153, /* No longer generated as of v18. */ 279 Bscan_buffer = 0153, /* No longer generated as of v18. */
294 Bset_mark = 0163, /* this loser is no longer generated as of v18 */ 280 Bset_mark = 0163, /* this loser is no longer generated as of v18 */
295#endif 281#endif
296}; 282};
297
298/* Whether to maintain a `top' and `bottom' field in the stack frame. */
299#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE
300
301/* Structure describing a value stack used during byte-code execution
302 in Fbyte_code. */
303
304struct byte_stack
305{
306 /* Program counter. This points into the byte_string below
307 and is relocated when that string is relocated. */
308 const unsigned char *pc;
309
310 /* Top and bottom of stack. The bottom points to an area of memory
311 allocated with alloca in Fbyte_code. */
312#if BYTE_MAINTAIN_TOP
313 Lisp_Object *top, *bottom;
314#endif
315
316 /* The string containing the byte-code, and its current address.
317 Storing this here protects it from GC because mark_byte_stack
318 marks it. */
319 Lisp_Object byte_string;
320 const unsigned char *byte_string_start;
321
322 /* Next entry in byte_stack_list. */
323 struct byte_stack *next;
324};
325
326/* A list of currently active byte-code execution value stacks.
327 Fbyte_code adds an entry to the head of this list before it starts
328 processing byte-code, and it removes the entry again when it is
329 done. Signaling an error truncates the list. */
330
331struct byte_stack *byte_stack_list;
332
333
334/* Relocate program counters in the stacks on byte_stack_list. Called
335 when GC has completed. */
336
337void
338relocate_byte_stack (void)
339{
340 struct byte_stack *stack;
341
342 for (stack = byte_stack_list; stack; stack = stack->next)
343 {
344 if (stack->byte_string_start != SDATA (stack->byte_string))
345 {
346 ptrdiff_t offset = stack->pc - stack->byte_string_start;
347 stack->byte_string_start = SDATA (stack->byte_string);
348 stack->pc = stack->byte_string_start + offset;
349 }
350 }
351}
352
353 283
354/* Fetch the next byte from the bytecode stream. */ 284/* Fetch the next byte from the bytecode stream. */
355 285
356#ifdef BYTE_CODE_SAFE 286#define FETCH (*pc++)
357#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++)
358#else
359#define FETCH *stack.pc++
360#endif
361 287
362/* Fetch two bytes from the bytecode stream and make a 16-bit number 288/* Fetch two bytes from the bytecode stream and make a 16-bit number
363 out of them. */ 289 out of them. */
364 290
365#define FETCH2 (op = FETCH, op + (FETCH << 8)) 291#define FETCH2 (op = FETCH, op + (FETCH << 8))
366 292
367/* Push x onto the execution stack. This used to be #define PUSH(x) 293/* Push X onto the execution stack. The expression X should not
368 (*++stackp = (x)) This oddity is necessary because Alliant can't be 294 contain TOP, to avoid competing side effects. */
369 bothered to compile the preincrement operator properly, as of 4/91.
370 -JimB */
371 295
372#define PUSH(x) (top++, *top = (x)) 296#define PUSH(x) (*++top = (x))
373 297
374/* Pop a value off the execution stack. */ 298/* Pop a value off the execution stack. */
375 299
@@ -384,60 +308,6 @@ relocate_byte_stack (void)
384 308
385#define TOP (*top) 309#define TOP (*top)
386 310
387/* Actions that must be performed before and after calling a function
388 that might GC. */
389
390#if !BYTE_MAINTAIN_TOP
391#define BEFORE_POTENTIAL_GC() ((void)0)
392#define AFTER_POTENTIAL_GC() ((void)0)
393#else
394#define BEFORE_POTENTIAL_GC() stack.top = top
395#define AFTER_POTENTIAL_GC() stack.top = NULL
396#endif
397
398/* Garbage collect if we have consed enough since the last time.
399 We do this at every branch, to avoid loops that never GC. */
400
401#define MAYBE_GC() \
402 do { \
403 BEFORE_POTENTIAL_GC (); \
404 maybe_gc (); \
405 AFTER_POTENTIAL_GC (); \
406 } while (0)
407
408/* Check for jumping out of range. */
409
410#ifdef BYTE_CODE_SAFE
411
412#define CHECK_RANGE(ARG) \
413 if (ARG >= bytestr_length) emacs_abort ()
414
415#else /* not BYTE_CODE_SAFE */
416
417#define CHECK_RANGE(ARG)
418
419#endif /* not BYTE_CODE_SAFE */
420
421/* A version of the QUIT macro which makes sure that the stack top is
422 set before signaling `quit'. */
423
424#define BYTE_CODE_QUIT \
425 do { \
426 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
427 { \
428 Lisp_Object flag = Vquit_flag; \
429 Vquit_flag = Qnil; \
430 BEFORE_POTENTIAL_GC (); \
431 if (EQ (Vthrow_on_input, flag)) \
432 Fthrow (Vthrow_on_input, Qt); \
433 Fsignal (Qquit, Qnil); \
434 AFTER_POTENTIAL_GC (); \
435 } \
436 else if (pending_signals) \
437 process_pending_signals (); \
438 } while (0)
439
440
441DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 311DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
442 doc: /* Function used internally in byte-compiled code. 312 doc: /* Function used internally in byte-compiled code.
443The first argument, BYTESTR, is a string of byte code; 313The first argument, BYTESTR, is a string of byte code;
@@ -467,41 +337,15 @@ Lisp_Object
467exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, 337exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
468 Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args) 338 Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
469{ 339{
470 ptrdiff_t count = SPECPDL_INDEX ();
471#ifdef BYTE_CODE_METER 340#ifdef BYTE_CODE_METER
472 int volatile this_op = 0; 341 int volatile this_op = 0;
473 int prev_op;
474#endif
475 int op;
476 /* Lisp_Object v1, v2; */
477 Lisp_Object *vectorp;
478#ifdef BYTE_CODE_SAFE
479 ptrdiff_t const_length;
480 Lisp_Object *stacke;
481 ptrdiff_t bytestr_length;
482#endif
483 struct byte_stack stack;
484 Lisp_Object *top;
485 Lisp_Object result;
486 enum handlertype type;
487
488#if 0 /* CHECK_FRAME_FONT */
489 {
490 struct frame *f = SELECTED_FRAME ();
491 if (FRAME_X_P (f)
492 && FRAME_FONT (f)->direction != 0
493 && FRAME_FONT (f)->direction != 1)
494 emacs_abort ();
495 }
496#endif 342#endif
497 343
498 CHECK_STRING (bytestr); 344 CHECK_STRING (bytestr);
499 CHECK_VECTOR (vector); 345 CHECK_VECTOR (vector);
500 CHECK_NATNUM (maxdepth); 346 CHECK_NATNUM (maxdepth);
501 347
502#ifdef BYTE_CODE_SAFE 348 ptrdiff_t const_length = ASIZE (vector);
503 const_length = ASIZE (vector);
504#endif
505 349
506 if (STRING_MULTIBYTE (bytestr)) 350 if (STRING_MULTIBYTE (bytestr))
507 /* BYTESTR must have been produced by Emacs 20.2 or the earlier 351 /* BYTESTR must have been produced by Emacs 20.2 or the earlier
@@ -511,90 +355,59 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
511 convert them back to the originally intended unibyte form. */ 355 convert them back to the originally intended unibyte form. */
512 bytestr = Fstring_as_unibyte (bytestr); 356 bytestr = Fstring_as_unibyte (bytestr);
513 357
514#ifdef BYTE_CODE_SAFE 358 ptrdiff_t bytestr_length = SBYTES (bytestr);
515 bytestr_length = SBYTES (bytestr); 359 Lisp_Object *vectorp = XVECTOR (vector)->contents;
516#endif 360
517 vectorp = XVECTOR (vector)->contents; 361 unsigned char quitcounter = 1;
518 362 EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
519 stack.byte_string = bytestr; 363 USE_SAFE_ALLOCA;
520 stack.pc = stack.byte_string_start = SDATA (bytestr); 364 Lisp_Object *stack_base;
521 if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth)) 365 SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length);
522 memory_full (SIZE_MAX); 366 Lisp_Object *stack_lim = stack_base + stack_items;
523 top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top); 367 Lisp_Object *top = stack_base;
524#if BYTE_MAINTAIN_TOP 368 memcpy (stack_lim, SDATA (bytestr), bytestr_length);
525 stack.bottom = top + 1; 369 void *void_stack_lim = stack_lim;
526 stack.top = NULL; 370 unsigned char const *bytestr_data = void_stack_lim;
527#endif 371 unsigned char const *pc = bytestr_data;
528 stack.next = byte_stack_list; 372 ptrdiff_t count = SPECPDL_INDEX ();
529 byte_stack_list = &stack;
530
531#ifdef BYTE_CODE_SAFE
532 stacke = stack.bottom - 1 + XFASTINT (maxdepth);
533#endif
534 373
535 if (INTEGERP (args_template)) 374 if (!NILP (args_template))
536 { 375 {
376 eassert (INTEGERP (args_template));
537 ptrdiff_t at = XINT (args_template); 377 ptrdiff_t at = XINT (args_template);
538 bool rest = (at & 128) != 0; 378 bool rest = (at & 128) != 0;
539 int mandatory = at & 127; 379 int mandatory = at & 127;
540 ptrdiff_t nonrest = at >> 8; 380 ptrdiff_t nonrest = at >> 8;
541 eassert (mandatory <= nonrest); 381 ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest;
542 if (nargs <= nonrest) 382 if (! (mandatory <= nargs && nargs <= maxargs))
543 {
544 ptrdiff_t i;
545 for (i = 0 ; i < nargs; i++, args++)
546 PUSH (*args);
547 if (nargs < mandatory)
548 /* Too few arguments. */
549 Fsignal (Qwrong_number_of_arguments,
550 list2 (Fcons (make_number (mandatory),
551 rest ? Qand_rest : make_number (nonrest)),
552 make_number (nargs)));
553 else
554 {
555 for (; i < nonrest; i++)
556 PUSH (Qnil);
557 if (rest)
558 PUSH (Qnil);
559 }
560 }
561 else if (rest)
562 {
563 ptrdiff_t i;
564 for (i = 0 ; i < nonrest; i++, args++)
565 PUSH (*args);
566 PUSH (Flist (nargs - nonrest, args));
567 }
568 else
569 /* Too many arguments. */
570 Fsignal (Qwrong_number_of_arguments, 383 Fsignal (Qwrong_number_of_arguments,
571 list2 (Fcons (make_number (mandatory), make_number (nonrest)), 384 list2 (Fcons (make_number (mandatory), make_number (nonrest)),
572 make_number (nargs))); 385 make_number (nargs)));
573 } 386 ptrdiff_t pushedargs = min (nonrest, nargs);
574 else if (! NILP (args_template)) 387 for (ptrdiff_t i = 0; i < pushedargs; i++, args++)
575 /* We should push some arguments on the stack. */ 388 PUSH (*args);
576 { 389 if (nonrest < nargs)
577 error ("Unknown args template!"); 390 PUSH (Flist (nargs - nonrest, args));
391 else
392 for (ptrdiff_t i = nargs - rest; i < nonrest; i++)
393 PUSH (Qnil);
578 } 394 }
579 395
580 while (1) 396 while (true)
581 { 397 {
582#ifdef BYTE_CODE_SAFE 398 int op;
583 if (top > stacke) 399 enum handlertype type;
584 emacs_abort (); 400
585 else if (top < stack.bottom - 1) 401 if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim))
586 emacs_abort (); 402 emacs_abort ();
587#endif
588 403
589#ifdef BYTE_CODE_METER 404#ifdef BYTE_CODE_METER
590 prev_op = this_op; 405 int prev_op = this_op;
591 this_op = op = FETCH; 406 this_op = op = FETCH;
592 METER_CODE (prev_op, op); 407 METER_CODE (prev_op, op);
593#else 408#elif !defined BYTE_CODE_THREADED
594#ifndef BYTE_CODE_THREADED
595 op = FETCH; 409 op = FETCH;
596#endif 410#endif
597#endif
598 411
599 /* The interpreter can be compiled one of two ways: as an 412 /* The interpreter can be compiled one of two ways: as an
600 ordinary switch-based interpreter, or as a threaded 413 ordinary switch-based interpreter, or as a threaded
@@ -637,7 +450,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
637 the table clearer. */ 450 the table clearer. */
638#define LABEL(OP) [OP] = &&insn_ ## OP 451#define LABEL(OP) [OP] = &&insn_ ## OP
639 452
640#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) 453#if GNUC_PREREQ (4, 6, 0)
641# pragma GCC diagnostic push 454# pragma GCC diagnostic push
642# pragma GCC diagnostic ignored "-Woverride-init" 455# pragma GCC diagnostic ignored "-Woverride-init"
643#elif defined __clang__ 456#elif defined __clang__
@@ -656,7 +469,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
656#undef DEFINE 469#undef DEFINE
657 }; 470 };
658 471
659#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) || defined __clang__ 472#if GNUC_PREREQ (4, 6, 0) || defined __clang__
660# pragma GCC diagnostic pop 473# pragma GCC diagnostic pop
661#endif 474#endif
662 475
@@ -675,7 +488,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
675 CASE (Bvarref3): 488 CASE (Bvarref3):
676 CASE (Bvarref4): 489 CASE (Bvarref4):
677 CASE (Bvarref5): 490 CASE (Bvarref5):
678 op = op - Bvarref; 491 op -= Bvarref;
679 goto varref; 492 goto varref;
680 493
681 /* This seems to be the most frequently executed byte-code 494 /* This seems to be the most frequently executed byte-code
@@ -684,92 +497,51 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
684 op = FETCH; 497 op = FETCH;
685 varref: 498 varref:
686 { 499 {
687 Lisp_Object v1, v2; 500 Lisp_Object v1 = vectorp[op], v2;
688 501 if (!SYMBOLP (v1)
689 v1 = vectorp[op]; 502 || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
690 if (SYMBOLP (v1)) 503 || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound)))
691 { 504 v2 = Fsymbol_value (v1);
692 if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
693 || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
694 EQ (v2, Qunbound)))
695 {
696 BEFORE_POTENTIAL_GC ();
697 v2 = Fsymbol_value (v1);
698 AFTER_POTENTIAL_GC ();
699 }
700 }
701 else
702 {
703 BEFORE_POTENTIAL_GC ();
704 v2 = Fsymbol_value (v1);
705 AFTER_POTENTIAL_GC ();
706 }
707 PUSH (v2); 505 PUSH (v2);
708 NEXT; 506 NEXT;
709 } 507 }
710 508
711 CASE (Bgotoifnil): 509 CASE (Bgotoifnil):
712 { 510 {
713 Lisp_Object v1; 511 Lisp_Object v1 = POP;
714 MAYBE_GC ();
715 op = FETCH2; 512 op = FETCH2;
716 v1 = POP;
717 if (NILP (v1)) 513 if (NILP (v1))
718 { 514 goto op_branch;
719 BYTE_CODE_QUIT;
720 CHECK_RANGE (op);
721 stack.pc = stack.byte_string_start + op;
722 }
723 NEXT; 515 NEXT;
724 } 516 }
725 517
726 CASE (Bcar): 518 CASE (Bcar):
727 { 519 if (CONSP (TOP))
728 Lisp_Object v1; 520 TOP = XCAR (TOP);
729 v1 = TOP; 521 else if (!NILP (TOP))
730 if (CONSP (v1)) 522 wrong_type_argument (Qlistp, TOP);
731 TOP = XCAR (v1); 523 NEXT;
732 else if (NILP (v1))
733 TOP = Qnil;
734 else
735 {
736 BEFORE_POTENTIAL_GC ();
737 wrong_type_argument (Qlistp, v1);
738 }
739 NEXT;
740 }
741 524
742 CASE (Beq): 525 CASE (Beq):
743 { 526 {
744 Lisp_Object v1; 527 Lisp_Object v1 = POP;
745 v1 = POP;
746 TOP = EQ (v1, TOP) ? Qt : Qnil; 528 TOP = EQ (v1, TOP) ? Qt : Qnil;
747 NEXT; 529 NEXT;
748 } 530 }
749 531
750 CASE (Bmemq): 532 CASE (Bmemq):
751 { 533 {
752 Lisp_Object v1; 534 Lisp_Object v1 = POP;
753 BEFORE_POTENTIAL_GC ();
754 v1 = POP;
755 TOP = Fmemq (TOP, v1); 535 TOP = Fmemq (TOP, v1);
756 AFTER_POTENTIAL_GC ();
757 NEXT; 536 NEXT;
758 } 537 }
759 538
760 CASE (Bcdr): 539 CASE (Bcdr):
761 { 540 {
762 Lisp_Object v1; 541 if (CONSP (TOP))
763 v1 = TOP; 542 TOP = XCDR (TOP);
764 if (CONSP (v1)) 543 else if (!NILP (TOP))
765 TOP = XCDR (v1); 544 wrong_type_argument (Qlistp, TOP);
766 else if (NILP (v1))
767 TOP = Qnil;
768 else
769 {
770 BEFORE_POTENTIAL_GC ();
771 wrong_type_argument (Qlistp, v1);
772 }
773 NEXT; 545 NEXT;
774 } 546 }
775 547
@@ -790,31 +562,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
790 op = FETCH; 562 op = FETCH;
791 varset: 563 varset:
792 { 564 {
793 Lisp_Object sym, val; 565 Lisp_Object sym = vectorp[op];
794 566 Lisp_Object val = POP;
795 sym = vectorp[op];
796 val = TOP;
797 567
798 /* Inline the most common case. */ 568 /* Inline the most common case. */
799 if (SYMBOLP (sym) 569 if (SYMBOLP (sym)
800 && !EQ (val, Qunbound) 570 && !EQ (val, Qunbound)
801 && !XSYMBOL (sym)->redirect 571 && !XSYMBOL (sym)->redirect
802 && !SYMBOL_CONSTANT_P (sym)) 572 && !SYMBOL_TRAPPED_WRITE_P (sym))
803 SET_SYMBOL_VAL (XSYMBOL (sym), val); 573 SET_SYMBOL_VAL (XSYMBOL (sym), val);
804 else 574 else
805 { 575 set_internal (sym, val, Qnil, SET_INTERNAL_SET);
806 BEFORE_POTENTIAL_GC ();
807 set_internal (sym, val, Qnil, 0);
808 AFTER_POTENTIAL_GC ();
809 }
810 } 576 }
811 (void) POP;
812 NEXT; 577 NEXT;
813 578
814 CASE (Bdup): 579 CASE (Bdup):
815 { 580 {
816 Lisp_Object v1; 581 Lisp_Object v1 = TOP;
817 v1 = TOP;
818 PUSH (v1); 582 PUSH (v1);
819 NEXT; 583 NEXT;
820 } 584 }
@@ -838,9 +602,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
838 op -= Bvarbind; 602 op -= Bvarbind;
839 varbind: 603 varbind:
840 /* Specbind can signal and thus GC. */ 604 /* Specbind can signal and thus GC. */
841 BEFORE_POTENTIAL_GC ();
842 specbind (vectorp[op], POP); 605 specbind (vectorp[op], POP);
843 AFTER_POTENTIAL_GC ();
844 NEXT; 606 NEXT;
845 607
846 CASE (Bcall6): 608 CASE (Bcall6):
@@ -860,15 +622,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
860 op -= Bcall; 622 op -= Bcall;
861 docall: 623 docall:
862 { 624 {
863 BEFORE_POTENTIAL_GC ();
864 DISCARD (op); 625 DISCARD (op);
865#ifdef BYTE_CODE_METER 626#ifdef BYTE_CODE_METER
866 if (byte_metering_on && SYMBOLP (TOP)) 627 if (byte_metering_on && SYMBOLP (TOP))
867 { 628 {
868 Lisp_Object v1, v2; 629 Lisp_Object v1 = TOP;
869 630 Lisp_Object v2 = Fget (v1, Qbyte_code_meter);
870 v1 = TOP;
871 v2 = Fget (v1, Qbyte_code_meter);
872 if (INTEGERP (v2) 631 if (INTEGERP (v2)
873 && XINT (v2) < MOST_POSITIVE_FIXNUM) 632 && XINT (v2) < MOST_POSITIVE_FIXNUM)
874 { 633 {
@@ -878,7 +637,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
878 } 637 }
879#endif 638#endif
880 TOP = Ffuncall (op + 1, &TOP); 639 TOP = Ffuncall (op + 1, &TOP);
881 AFTER_POTENTIAL_GC ();
882 NEXT; 640 NEXT;
883 } 641 }
884 642
@@ -898,124 +656,85 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
898 CASE (Bunbind5): 656 CASE (Bunbind5):
899 op -= Bunbind; 657 op -= Bunbind;
900 dounbind: 658 dounbind:
901 BEFORE_POTENTIAL_GC ();
902 unbind_to (SPECPDL_INDEX () - op, Qnil); 659 unbind_to (SPECPDL_INDEX () - op, Qnil);
903 AFTER_POTENTIAL_GC ();
904 NEXT; 660 NEXT;
905 661
906 CASE (Bunbind_all): /* Obsolete. Never used. */ 662 CASE (Bunbind_all): /* Obsolete. Never used. */
907 /* To unbind back to the beginning of this frame. Not used yet, 663 /* To unbind back to the beginning of this frame. Not used yet,
908 but will be needed for tail-recursion elimination. */ 664 but will be needed for tail-recursion elimination. */
909 BEFORE_POTENTIAL_GC ();
910 unbind_to (count, Qnil); 665 unbind_to (count, Qnil);
911 AFTER_POTENTIAL_GC ();
912 NEXT; 666 NEXT;
913 667
914 CASE (Bgoto): 668 CASE (Bgoto):
915 MAYBE_GC (); 669 op = FETCH2;
916 BYTE_CODE_QUIT; 670 op_branch:
917 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ 671 op -= pc - bytestr_data;
918 CHECK_RANGE (op); 672 op_relative_branch:
919 stack.pc = stack.byte_string_start + op; 673 if (BYTE_CODE_SAFE
674 && ! (bytestr_data - pc <= op
675 && op < bytestr_data + bytestr_length - pc))
676 emacs_abort ();
677 quitcounter += op < 0;
678 if (!quitcounter)
679 {
680 quitcounter = 1;
681 maybe_gc ();
682 QUIT;
683 }
684 pc += op;
920 NEXT; 685 NEXT;
921 686
922 CASE (Bgotoifnonnil): 687 CASE (Bgotoifnonnil):
923 { 688 op = FETCH2;
924 Lisp_Object v1; 689 if (!NILP (POP))
925 MAYBE_GC (); 690 goto op_branch;
926 op = FETCH2; 691 NEXT;
927 v1 = POP;
928 if (!NILP (v1))
929 {
930 BYTE_CODE_QUIT;
931 CHECK_RANGE (op);
932 stack.pc = stack.byte_string_start + op;
933 }
934 NEXT;
935 }
936 692
937 CASE (Bgotoifnilelsepop): 693 CASE (Bgotoifnilelsepop):
938 MAYBE_GC ();
939 op = FETCH2; 694 op = FETCH2;
940 if (NILP (TOP)) 695 if (NILP (TOP))
941 { 696 goto op_branch;
942 BYTE_CODE_QUIT; 697 DISCARD (1);
943 CHECK_RANGE (op);
944 stack.pc = stack.byte_string_start + op;
945 }
946 else DISCARD (1);
947 NEXT; 698 NEXT;
948 699
949 CASE (Bgotoifnonnilelsepop): 700 CASE (Bgotoifnonnilelsepop):
950 MAYBE_GC ();
951 op = FETCH2; 701 op = FETCH2;
952 if (!NILP (TOP)) 702 if (!NILP (TOP))
953 { 703 goto op_branch;
954 BYTE_CODE_QUIT; 704 DISCARD (1);
955 CHECK_RANGE (op);
956 stack.pc = stack.byte_string_start + op;
957 }
958 else DISCARD (1);
959 NEXT; 705 NEXT;
960 706
961 CASE (BRgoto): 707 CASE (BRgoto):
962 MAYBE_GC (); 708 op = FETCH - 128;
963 BYTE_CODE_QUIT; 709 goto op_relative_branch;
964 stack.pc += (int) *stack.pc - 127;
965 NEXT;
966 710
967 CASE (BRgotoifnil): 711 CASE (BRgotoifnil):
968 { 712 op = FETCH - 128;
969 Lisp_Object v1; 713 if (NILP (POP))
970 MAYBE_GC (); 714 goto op_relative_branch;
971 v1 = POP; 715 NEXT;
972 if (NILP (v1))
973 {
974 BYTE_CODE_QUIT;
975 stack.pc += (int) *stack.pc - 128;
976 }
977 stack.pc++;
978 NEXT;
979 }
980 716
981 CASE (BRgotoifnonnil): 717 CASE (BRgotoifnonnil):
982 { 718 op = FETCH - 128;
983 Lisp_Object v1; 719 if (!NILP (POP))
984 MAYBE_GC (); 720 goto op_relative_branch;
985 v1 = POP; 721 NEXT;
986 if (!NILP (v1))
987 {
988 BYTE_CODE_QUIT;
989 stack.pc += (int) *stack.pc - 128;
990 }
991 stack.pc++;
992 NEXT;
993 }
994 722
995 CASE (BRgotoifnilelsepop): 723 CASE (BRgotoifnilelsepop):
996 MAYBE_GC (); 724 op = FETCH - 128;
997 op = *stack.pc++;
998 if (NILP (TOP)) 725 if (NILP (TOP))
999 { 726 goto op_relative_branch;
1000 BYTE_CODE_QUIT; 727 DISCARD (1);
1001 stack.pc += op - 128;
1002 }
1003 else DISCARD (1);
1004 NEXT; 728 NEXT;
1005 729
1006 CASE (BRgotoifnonnilelsepop): 730 CASE (BRgotoifnonnilelsepop):
1007 MAYBE_GC (); 731 op = FETCH - 128;
1008 op = *stack.pc++;
1009 if (!NILP (TOP)) 732 if (!NILP (TOP))
1010 { 733 goto op_relative_branch;
1011 BYTE_CODE_QUIT; 734 DISCARD (1);
1012 stack.pc += op - 128;
1013 }
1014 else DISCARD (1);
1015 NEXT; 735 NEXT;
1016 736
1017 CASE (Breturn): 737 CASE (Breturn):
1018 result = POP;
1019 goto exit; 738 goto exit;
1020 739
1021 CASE (Bdiscard): 740 CASE (Bdiscard):
@@ -1041,10 +760,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1041 ptrdiff_t count1 = SPECPDL_INDEX (); 760 ptrdiff_t count1 = SPECPDL_INDEX ();
1042 record_unwind_protect (restore_window_configuration, 761 record_unwind_protect (restore_window_configuration,
1043 Fcurrent_window_configuration (Qnil)); 762 Fcurrent_window_configuration (Qnil));
1044 BEFORE_POTENTIAL_GC ();
1045 TOP = Fprogn (TOP); 763 TOP = Fprogn (TOP);
1046 unbind_to (count1, TOP); 764 unbind_to (count1, TOP);
1047 AFTER_POTENTIAL_GC ();
1048 NEXT; 765 NEXT;
1049 } 766 }
1050 767
@@ -1055,11 +772,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1055 772
1056 CASE (Bcatch): /* Obsolete since 24.4. */ 773 CASE (Bcatch): /* Obsolete since 24.4. */
1057 { 774 {
1058 Lisp_Object v1; 775 Lisp_Object v1 = POP;
1059 BEFORE_POTENTIAL_GC ();
1060 v1 = POP;
1061 TOP = internal_catch (TOP, eval_sub, v1); 776 TOP = internal_catch (TOP, eval_sub, v1);
1062 AFTER_POTENTIAL_GC ();
1063 NEXT; 777 NEXT;
1064 } 778 }
1065 779
@@ -1070,93 +784,69 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1070 type = CONDITION_CASE; 784 type = CONDITION_CASE;
1071 pushhandler: 785 pushhandler:
1072 { 786 {
1073 Lisp_Object tag = POP; 787 struct handler *c = push_handler (POP, type);
1074 int dest = FETCH2; 788 c->bytecode_dest = FETCH2;
1075
1076 struct handler *c = push_handler (tag, type);
1077 c->bytecode_dest = dest;
1078 c->bytecode_top = top; 789 c->bytecode_top = top;
1079 790
1080 if (sys_setjmp (c->jmp)) 791 if (sys_setjmp (c->jmp))
1081 { 792 {
1082 struct handler *c = handlerlist; 793 struct handler *c = handlerlist;
1083 int dest;
1084 top = c->bytecode_top; 794 top = c->bytecode_top;
1085 dest = c->bytecode_dest; 795 op = c->bytecode_dest;
1086 handlerlist = c->next; 796 handlerlist = c->next;
1087 PUSH (c->val); 797 PUSH (c->val);
1088 CHECK_RANGE (dest); 798 goto op_branch;
1089 /* Might have been re-set by longjmp! */
1090 stack.byte_string_start = SDATA (stack.byte_string);
1091 stack.pc = stack.byte_string_start + dest;
1092 } 799 }
1093 800
1094 NEXT; 801 NEXT;
1095 } 802 }
1096 803
1097 CASE (Bpophandler): /* New in 24.4. */ 804 CASE (Bpophandler): /* New in 24.4. */
1098 { 805 handlerlist = handlerlist->next;
1099 handlerlist = handlerlist->next; 806 NEXT;
1100 NEXT;
1101 }
1102 807
1103 CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */ 808 CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
1104 { 809 {
1105 Lisp_Object handler = POP; 810 Lisp_Object handler = POP;
1106 /* Support for a function here is new in 24.4. */ 811 /* Support for a function here is new in 24.4. */
1107 record_unwind_protect (NILP (Ffunctionp (handler)) 812 record_unwind_protect (FUNCTIONP (handler) ? bcall0 : unwind_body,
1108 ? unwind_body : bcall0,
1109 handler); 813 handler);
1110 NEXT; 814 NEXT;
1111 } 815 }
1112 816
1113 CASE (Bcondition_case): /* Obsolete since 24.4. */ 817 CASE (Bcondition_case): /* Obsolete since 24.4. */
1114 { 818 {
1115 Lisp_Object handlers, body; 819 Lisp_Object handlers = POP, body = POP;
1116 handlers = POP;
1117 body = POP;
1118 BEFORE_POTENTIAL_GC ();
1119 TOP = internal_lisp_condition_case (TOP, body, handlers); 820 TOP = internal_lisp_condition_case (TOP, body, handlers);
1120 AFTER_POTENTIAL_GC ();
1121 NEXT; 821 NEXT;
1122 } 822 }
1123 823
1124 CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */ 824 CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */
1125 BEFORE_POTENTIAL_GC ();
1126 CHECK_STRING (TOP); 825 CHECK_STRING (TOP);
1127 temp_output_buffer_setup (SSDATA (TOP)); 826 temp_output_buffer_setup (SSDATA (TOP));
1128 AFTER_POTENTIAL_GC ();
1129 TOP = Vstandard_output; 827 TOP = Vstandard_output;
1130 NEXT; 828 NEXT;
1131 829
1132 CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */ 830 CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */
1133 { 831 {
1134 Lisp_Object v1; 832 Lisp_Object v1 = POP;
1135 BEFORE_POTENTIAL_GC ();
1136 v1 = POP;
1137 temp_output_buffer_show (TOP); 833 temp_output_buffer_show (TOP);
1138 TOP = v1; 834 TOP = v1;
1139 /* pop binding of standard-output */ 835 /* pop binding of standard-output */
1140 unbind_to (SPECPDL_INDEX () - 1, Qnil); 836 unbind_to (SPECPDL_INDEX () - 1, Qnil);
1141 AFTER_POTENTIAL_GC ();
1142 NEXT; 837 NEXT;
1143 } 838 }
1144 839
1145 CASE (Bnth): 840 CASE (Bnth):
1146 { 841 {
1147 Lisp_Object v1, v2; 842 Lisp_Object v2 = POP, v1 = TOP;
1148 EMACS_INT n; 843 CHECK_NUMBER (v1);
1149 BEFORE_POTENTIAL_GC (); 844 EMACS_INT n = XINT (v1);
1150 v1 = POP; 845 immediate_quit = true;
1151 v2 = TOP; 846 while (--n >= 0 && CONSP (v2))
1152 CHECK_NUMBER (v2); 847 v2 = XCDR (v2);
1153 n = XINT (v2); 848 immediate_quit = false;
1154 immediate_quit = 1; 849 TOP = CAR (v2);
1155 while (--n >= 0 && CONSP (v1))
1156 v1 = XCDR (v1);
1157 immediate_quit = 0;
1158 TOP = CAR (v1);
1159 AFTER_POTENTIAL_GC ();
1160 NEXT; 850 NEXT;
1161 } 851 }
1162 852
@@ -1182,8 +872,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1182 872
1183 CASE (Bcons): 873 CASE (Bcons):
1184 { 874 {
1185 Lisp_Object v1; 875 Lisp_Object v1 = POP;
1186 v1 = POP;
1187 TOP = Fcons (TOP, v1); 876 TOP = Fcons (TOP, v1);
1188 NEXT; 877 NEXT;
1189 } 878 }
@@ -1194,8 +883,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1194 883
1195 CASE (Blist2): 884 CASE (Blist2):
1196 { 885 {
1197 Lisp_Object v1; 886 Lisp_Object v1 = POP;
1198 v1 = POP;
1199 TOP = list2 (TOP, v1); 887 TOP = list2 (TOP, v1);
1200 NEXT; 888 NEXT;
1201 } 889 }
@@ -1217,305 +905,191 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1217 NEXT; 905 NEXT;
1218 906
1219 CASE (Blength): 907 CASE (Blength):
1220 BEFORE_POTENTIAL_GC ();
1221 TOP = Flength (TOP); 908 TOP = Flength (TOP);
1222 AFTER_POTENTIAL_GC ();
1223 NEXT; 909 NEXT;
1224 910
1225 CASE (Baref): 911 CASE (Baref):
1226 { 912 {
1227 Lisp_Object v1; 913 Lisp_Object v1 = POP;
1228 BEFORE_POTENTIAL_GC ();
1229 v1 = POP;
1230 TOP = Faref (TOP, v1); 914 TOP = Faref (TOP, v1);
1231 AFTER_POTENTIAL_GC ();
1232 NEXT; 915 NEXT;
1233 } 916 }
1234 917
1235 CASE (Baset): 918 CASE (Baset):
1236 { 919 {
1237 Lisp_Object v1, v2; 920 Lisp_Object v2 = POP, v1 = POP;
1238 BEFORE_POTENTIAL_GC ();
1239 v2 = POP; v1 = POP;
1240 TOP = Faset (TOP, v1, v2); 921 TOP = Faset (TOP, v1, v2);
1241 AFTER_POTENTIAL_GC ();
1242 NEXT; 922 NEXT;
1243 } 923 }
1244 924
1245 CASE (Bsymbol_value): 925 CASE (Bsymbol_value):
1246 BEFORE_POTENTIAL_GC ();
1247 TOP = Fsymbol_value (TOP); 926 TOP = Fsymbol_value (TOP);
1248 AFTER_POTENTIAL_GC ();
1249 NEXT; 927 NEXT;
1250 928
1251 CASE (Bsymbol_function): 929 CASE (Bsymbol_function):
1252 BEFORE_POTENTIAL_GC ();
1253 TOP = Fsymbol_function (TOP); 930 TOP = Fsymbol_function (TOP);
1254 AFTER_POTENTIAL_GC ();
1255 NEXT; 931 NEXT;
1256 932
1257 CASE (Bset): 933 CASE (Bset):
1258 { 934 {
1259 Lisp_Object v1; 935 Lisp_Object v1 = POP;
1260 BEFORE_POTENTIAL_GC ();
1261 v1 = POP;
1262 TOP = Fset (TOP, v1); 936 TOP = Fset (TOP, v1);
1263 AFTER_POTENTIAL_GC ();
1264 NEXT; 937 NEXT;
1265 } 938 }
1266 939
1267 CASE (Bfset): 940 CASE (Bfset):
1268 { 941 {
1269 Lisp_Object v1; 942 Lisp_Object v1 = POP;
1270 BEFORE_POTENTIAL_GC ();
1271 v1 = POP;
1272 TOP = Ffset (TOP, v1); 943 TOP = Ffset (TOP, v1);
1273 AFTER_POTENTIAL_GC ();
1274 NEXT; 944 NEXT;
1275 } 945 }
1276 946
1277 CASE (Bget): 947 CASE (Bget):
1278 { 948 {
1279 Lisp_Object v1; 949 Lisp_Object v1 = POP;
1280 BEFORE_POTENTIAL_GC ();
1281 v1 = POP;
1282 TOP = Fget (TOP, v1); 950 TOP = Fget (TOP, v1);
1283 AFTER_POTENTIAL_GC ();
1284 NEXT; 951 NEXT;
1285 } 952 }
1286 953
1287 CASE (Bsubstring): 954 CASE (Bsubstring):
1288 { 955 {
1289 Lisp_Object v1, v2; 956 Lisp_Object v2 = POP, v1 = POP;
1290 BEFORE_POTENTIAL_GC ();
1291 v2 = POP; v1 = POP;
1292 TOP = Fsubstring (TOP, v1, v2); 957 TOP = Fsubstring (TOP, v1, v2);
1293 AFTER_POTENTIAL_GC ();
1294 NEXT; 958 NEXT;
1295 } 959 }
1296 960
1297 CASE (Bconcat2): 961 CASE (Bconcat2):
1298 BEFORE_POTENTIAL_GC ();
1299 DISCARD (1); 962 DISCARD (1);
1300 TOP = Fconcat (2, &TOP); 963 TOP = Fconcat (2, &TOP);
1301 AFTER_POTENTIAL_GC ();
1302 NEXT; 964 NEXT;
1303 965
1304 CASE (Bconcat3): 966 CASE (Bconcat3):
1305 BEFORE_POTENTIAL_GC ();
1306 DISCARD (2); 967 DISCARD (2);
1307 TOP = Fconcat (3, &TOP); 968 TOP = Fconcat (3, &TOP);
1308 AFTER_POTENTIAL_GC ();
1309 NEXT; 969 NEXT;
1310 970
1311 CASE (Bconcat4): 971 CASE (Bconcat4):
1312 BEFORE_POTENTIAL_GC ();
1313 DISCARD (3); 972 DISCARD (3);
1314 TOP = Fconcat (4, &TOP); 973 TOP = Fconcat (4, &TOP);
1315 AFTER_POTENTIAL_GC ();
1316 NEXT; 974 NEXT;
1317 975
1318 CASE (BconcatN): 976 CASE (BconcatN):
1319 op = FETCH; 977 op = FETCH;
1320 BEFORE_POTENTIAL_GC ();
1321 DISCARD (op - 1); 978 DISCARD (op - 1);
1322 TOP = Fconcat (op, &TOP); 979 TOP = Fconcat (op, &TOP);
1323 AFTER_POTENTIAL_GC ();
1324 NEXT; 980 NEXT;
1325 981
1326 CASE (Bsub1): 982 CASE (Bsub1):
1327 { 983 TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP);
1328 Lisp_Object v1; 984 NEXT;
1329 v1 = TOP;
1330 if (INTEGERP (v1))
1331 {
1332 XSETINT (v1, XINT (v1) - 1);
1333 TOP = v1;
1334 }
1335 else
1336 {
1337 BEFORE_POTENTIAL_GC ();
1338 TOP = Fsub1 (v1);
1339 AFTER_POTENTIAL_GC ();
1340 }
1341 NEXT;
1342 }
1343 985
1344 CASE (Badd1): 986 CASE (Badd1):
1345 { 987 TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP);
1346 Lisp_Object v1; 988 NEXT;
1347 v1 = TOP;
1348 if (INTEGERP (v1))
1349 {
1350 XSETINT (v1, XINT (v1) + 1);
1351 TOP = v1;
1352 }
1353 else
1354 {
1355 BEFORE_POTENTIAL_GC ();
1356 TOP = Fadd1 (v1);
1357 AFTER_POTENTIAL_GC ();
1358 }
1359 NEXT;
1360 }
1361 989
1362 CASE (Beqlsign): 990 CASE (Beqlsign):
1363 { 991 {
1364 Lisp_Object v1, v2; 992 Lisp_Object v2 = POP, v1 = TOP;
1365 BEFORE_POTENTIAL_GC ();
1366 v2 = POP; v1 = TOP;
1367 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1); 993 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1368 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2); 994 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1369 AFTER_POTENTIAL_GC (); 995 bool equal;
1370 if (FLOATP (v1) || FLOATP (v2)) 996 if (FLOATP (v1) || FLOATP (v2))
1371 { 997 {
1372 double f1, f2; 998 double f1 = FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1);
1373 999 double f2 = FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2);
1374 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1)); 1000 equal = f1 == f2;
1375 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1376 TOP = (f1 == f2 ? Qt : Qnil);
1377 } 1001 }
1378 else 1002 else
1379 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); 1003 equal = XINT (v1) == XINT (v2);
1004 TOP = equal ? Qt : Qnil;
1380 NEXT; 1005 NEXT;
1381 } 1006 }
1382 1007
1383 CASE (Bgtr): 1008 CASE (Bgtr):
1384 { 1009 {
1385 Lisp_Object v1; 1010 Lisp_Object v1 = POP;
1386 BEFORE_POTENTIAL_GC ();
1387 v1 = POP;
1388 TOP = arithcompare (TOP, v1, ARITH_GRTR); 1011 TOP = arithcompare (TOP, v1, ARITH_GRTR);
1389 AFTER_POTENTIAL_GC ();
1390 NEXT; 1012 NEXT;
1391 } 1013 }
1392 1014
1393 CASE (Blss): 1015 CASE (Blss):
1394 { 1016 {
1395 Lisp_Object v1; 1017 Lisp_Object v1 = POP;
1396 BEFORE_POTENTIAL_GC ();
1397 v1 = POP;
1398 TOP = arithcompare (TOP, v1, ARITH_LESS); 1018 TOP = arithcompare (TOP, v1, ARITH_LESS);
1399 AFTER_POTENTIAL_GC ();
1400 NEXT; 1019 NEXT;
1401 } 1020 }
1402 1021
1403 CASE (Bleq): 1022 CASE (Bleq):
1404 { 1023 {
1405 Lisp_Object v1; 1024 Lisp_Object v1 = POP;
1406 BEFORE_POTENTIAL_GC ();
1407 v1 = POP;
1408 TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); 1025 TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
1409 AFTER_POTENTIAL_GC ();
1410 NEXT; 1026 NEXT;
1411 } 1027 }
1412 1028
1413 CASE (Bgeq): 1029 CASE (Bgeq):
1414 { 1030 {
1415 Lisp_Object v1; 1031 Lisp_Object v1 = POP;
1416 BEFORE_POTENTIAL_GC ();
1417 v1 = POP;
1418 TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); 1032 TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL);
1419 AFTER_POTENTIAL_GC ();
1420 NEXT; 1033 NEXT;
1421 } 1034 }
1422 1035
1423 CASE (Bdiff): 1036 CASE (Bdiff):
1424 BEFORE_POTENTIAL_GC ();
1425 DISCARD (1); 1037 DISCARD (1);
1426 TOP = Fminus (2, &TOP); 1038 TOP = Fminus (2, &TOP);
1427 AFTER_POTENTIAL_GC ();
1428 NEXT; 1039 NEXT;
1429 1040
1430 CASE (Bnegate): 1041 CASE (Bnegate):
1431 { 1042 TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP);
1432 Lisp_Object v1; 1043 NEXT;
1433 v1 = TOP;
1434 if (INTEGERP (v1))
1435 {
1436 XSETINT (v1, - XINT (v1));
1437 TOP = v1;
1438 }
1439 else
1440 {
1441 BEFORE_POTENTIAL_GC ();
1442 TOP = Fminus (1, &TOP);
1443 AFTER_POTENTIAL_GC ();
1444 }
1445 NEXT;
1446 }
1447 1044
1448 CASE (Bplus): 1045 CASE (Bplus):
1449 BEFORE_POTENTIAL_GC ();
1450 DISCARD (1); 1046 DISCARD (1);
1451 TOP = Fplus (2, &TOP); 1047 TOP = Fplus (2, &TOP);
1452 AFTER_POTENTIAL_GC ();
1453 NEXT; 1048 NEXT;
1454 1049
1455 CASE (Bmax): 1050 CASE (Bmax):
1456 BEFORE_POTENTIAL_GC ();
1457 DISCARD (1); 1051 DISCARD (1);
1458 TOP = Fmax (2, &TOP); 1052 TOP = Fmax (2, &TOP);
1459 AFTER_POTENTIAL_GC ();
1460 NEXT; 1053 NEXT;
1461 1054
1462 CASE (Bmin): 1055 CASE (Bmin):
1463 BEFORE_POTENTIAL_GC ();
1464 DISCARD (1); 1056 DISCARD (1);
1465 TOP = Fmin (2, &TOP); 1057 TOP = Fmin (2, &TOP);
1466 AFTER_POTENTIAL_GC ();
1467 NEXT; 1058 NEXT;
1468 1059
1469 CASE (Bmult): 1060 CASE (Bmult):
1470 BEFORE_POTENTIAL_GC ();
1471 DISCARD (1); 1061 DISCARD (1);
1472 TOP = Ftimes (2, &TOP); 1062 TOP = Ftimes (2, &TOP);
1473 AFTER_POTENTIAL_GC ();
1474 NEXT; 1063 NEXT;
1475 1064
1476 CASE (Bquo): 1065 CASE (Bquo):
1477 BEFORE_POTENTIAL_GC ();
1478 DISCARD (1); 1066 DISCARD (1);
1479 TOP = Fquo (2, &TOP); 1067 TOP = Fquo (2, &TOP);
1480 AFTER_POTENTIAL_GC ();
1481 NEXT; 1068 NEXT;
1482 1069
1483 CASE (Brem): 1070 CASE (Brem):
1484 { 1071 {
1485 Lisp_Object v1; 1072 Lisp_Object v1 = POP;
1486 BEFORE_POTENTIAL_GC ();
1487 v1 = POP;
1488 TOP = Frem (TOP, v1); 1073 TOP = Frem (TOP, v1);
1489 AFTER_POTENTIAL_GC ();
1490 NEXT; 1074 NEXT;
1491 } 1075 }
1492 1076
1493 CASE (Bpoint): 1077 CASE (Bpoint):
1494 { 1078 PUSH (make_natnum (PT));
1495 Lisp_Object v1; 1079 NEXT;
1496 XSETFASTINT (v1, PT);
1497 PUSH (v1);
1498 NEXT;
1499 }
1500 1080
1501 CASE (Bgoto_char): 1081 CASE (Bgoto_char):
1502 BEFORE_POTENTIAL_GC ();
1503 TOP = Fgoto_char (TOP); 1082 TOP = Fgoto_char (TOP);
1504 AFTER_POTENTIAL_GC ();
1505 NEXT; 1083 NEXT;
1506 1084
1507 CASE (Binsert): 1085 CASE (Binsert):
1508 BEFORE_POTENTIAL_GC ();
1509 TOP = Finsert (1, &TOP); 1086 TOP = Finsert (1, &TOP);
1510 AFTER_POTENTIAL_GC ();
1511 NEXT; 1087 NEXT;
1512 1088
1513 CASE (BinsertN): 1089 CASE (BinsertN):
1514 op = FETCH; 1090 op = FETCH;
1515 BEFORE_POTENTIAL_GC ();
1516 DISCARD (op - 1); 1091 DISCARD (op - 1);
1517 TOP = Finsert (op, &TOP); 1092 TOP = Finsert (op, &TOP);
1518 AFTER_POTENTIAL_GC ();
1519 NEXT; 1093 NEXT;
1520 1094
1521 CASE (Bpoint_max): 1095 CASE (Bpoint_max):
@@ -1527,53 +1101,27 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1527 } 1101 }
1528 1102
1529 CASE (Bpoint_min): 1103 CASE (Bpoint_min):
1530 { 1104 PUSH (make_natnum (BEGV));
1531 Lisp_Object v1; 1105 NEXT;
1532 XSETFASTINT (v1, BEGV);
1533 PUSH (v1);
1534 NEXT;
1535 }
1536 1106
1537 CASE (Bchar_after): 1107 CASE (Bchar_after):
1538 BEFORE_POTENTIAL_GC ();
1539 TOP = Fchar_after (TOP); 1108 TOP = Fchar_after (TOP);
1540 AFTER_POTENTIAL_GC ();
1541 NEXT; 1109 NEXT;
1542 1110
1543 CASE (Bfollowing_char): 1111 CASE (Bfollowing_char):
1544 { 1112 PUSH (Ffollowing_char ());
1545 Lisp_Object v1; 1113 NEXT;
1546 BEFORE_POTENTIAL_GC ();
1547 v1 = Ffollowing_char ();
1548 AFTER_POTENTIAL_GC ();
1549 PUSH (v1);
1550 NEXT;
1551 }
1552 1114
1553 CASE (Bpreceding_char): 1115 CASE (Bpreceding_char):
1554 { 1116 PUSH (Fprevious_char ());
1555 Lisp_Object v1; 1117 NEXT;
1556 BEFORE_POTENTIAL_GC ();
1557 v1 = Fprevious_char ();
1558 AFTER_POTENTIAL_GC ();
1559 PUSH (v1);
1560 NEXT;
1561 }
1562 1118
1563 CASE (Bcurrent_column): 1119 CASE (Bcurrent_column):
1564 { 1120 PUSH (make_natnum (current_column ()));
1565 Lisp_Object v1; 1121 NEXT;
1566 BEFORE_POTENTIAL_GC ();
1567 XSETFASTINT (v1, current_column ());
1568 AFTER_POTENTIAL_GC ();
1569 PUSH (v1);
1570 NEXT;
1571 }
1572 1122
1573 CASE (Bindent_to): 1123 CASE (Bindent_to):
1574 BEFORE_POTENTIAL_GC ();
1575 TOP = Findent_to (TOP, Qnil); 1124 TOP = Findent_to (TOP, Qnil);
1576 AFTER_POTENTIAL_GC ();
1577 NEXT; 1125 NEXT;
1578 1126
1579 CASE (Beolp): 1127 CASE (Beolp):
@@ -1597,63 +1145,43 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1597 NEXT; 1145 NEXT;
1598 1146
1599 CASE (Bset_buffer): 1147 CASE (Bset_buffer):
1600 BEFORE_POTENTIAL_GC ();
1601 TOP = Fset_buffer (TOP); 1148 TOP = Fset_buffer (TOP);
1602 AFTER_POTENTIAL_GC ();
1603 NEXT; 1149 NEXT;
1604 1150
1605 CASE (Binteractive_p): /* Obsolete since 24.1. */ 1151 CASE (Binteractive_p): /* Obsolete since 24.1. */
1606 BEFORE_POTENTIAL_GC ();
1607 PUSH (call0 (intern ("interactive-p"))); 1152 PUSH (call0 (intern ("interactive-p")));
1608 AFTER_POTENTIAL_GC ();
1609 NEXT; 1153 NEXT;
1610 1154
1611 CASE (Bforward_char): 1155 CASE (Bforward_char):
1612 BEFORE_POTENTIAL_GC ();
1613 TOP = Fforward_char (TOP); 1156 TOP = Fforward_char (TOP);
1614 AFTER_POTENTIAL_GC ();
1615 NEXT; 1157 NEXT;
1616 1158
1617 CASE (Bforward_word): 1159 CASE (Bforward_word):
1618 BEFORE_POTENTIAL_GC ();
1619 TOP = Fforward_word (TOP); 1160 TOP = Fforward_word (TOP);
1620 AFTER_POTENTIAL_GC ();
1621 NEXT; 1161 NEXT;
1622 1162
1623 CASE (Bskip_chars_forward): 1163 CASE (Bskip_chars_forward):
1624 { 1164 {
1625 Lisp_Object v1; 1165 Lisp_Object v1 = POP;
1626 BEFORE_POTENTIAL_GC ();
1627 v1 = POP;
1628 TOP = Fskip_chars_forward (TOP, v1); 1166 TOP = Fskip_chars_forward (TOP, v1);
1629 AFTER_POTENTIAL_GC ();
1630 NEXT; 1167 NEXT;
1631 } 1168 }
1632 1169
1633 CASE (Bskip_chars_backward): 1170 CASE (Bskip_chars_backward):
1634 { 1171 {
1635 Lisp_Object v1; 1172 Lisp_Object v1 = POP;
1636 BEFORE_POTENTIAL_GC ();
1637 v1 = POP;
1638 TOP = Fskip_chars_backward (TOP, v1); 1173 TOP = Fskip_chars_backward (TOP, v1);
1639 AFTER_POTENTIAL_GC ();
1640 NEXT; 1174 NEXT;
1641 } 1175 }
1642 1176
1643 CASE (Bforward_line): 1177 CASE (Bforward_line):
1644 BEFORE_POTENTIAL_GC ();
1645 TOP = Fforward_line (TOP); 1178 TOP = Fforward_line (TOP);
1646 AFTER_POTENTIAL_GC ();
1647 NEXT; 1179 NEXT;
1648 1180
1649 CASE (Bchar_syntax): 1181 CASE (Bchar_syntax):
1650 { 1182 {
1651 int c;
1652
1653 BEFORE_POTENTIAL_GC ();
1654 CHECK_CHARACTER (TOP); 1183 CHECK_CHARACTER (TOP);
1655 AFTER_POTENTIAL_GC (); 1184 int c = XFASTINT (TOP);
1656 c = XFASTINT (TOP);
1657 if (NILP (BVAR (current_buffer, enable_multibyte_characters))) 1185 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1658 MAKE_CHAR_MULTIBYTE (c); 1186 MAKE_CHAR_MULTIBYTE (c);
1659 XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); 1187 XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
@@ -1662,239 +1190,169 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1662 1190
1663 CASE (Bbuffer_substring): 1191 CASE (Bbuffer_substring):
1664 { 1192 {
1665 Lisp_Object v1; 1193 Lisp_Object v1 = POP;
1666 BEFORE_POTENTIAL_GC ();
1667 v1 = POP;
1668 TOP = Fbuffer_substring (TOP, v1); 1194 TOP = Fbuffer_substring (TOP, v1);
1669 AFTER_POTENTIAL_GC ();
1670 NEXT; 1195 NEXT;
1671 } 1196 }
1672 1197
1673 CASE (Bdelete_region): 1198 CASE (Bdelete_region):
1674 { 1199 {
1675 Lisp_Object v1; 1200 Lisp_Object v1 = POP;
1676 BEFORE_POTENTIAL_GC ();
1677 v1 = POP;
1678 TOP = Fdelete_region (TOP, v1); 1201 TOP = Fdelete_region (TOP, v1);
1679 AFTER_POTENTIAL_GC ();
1680 NEXT; 1202 NEXT;
1681 } 1203 }
1682 1204
1683 CASE (Bnarrow_to_region): 1205 CASE (Bnarrow_to_region):
1684 { 1206 {
1685 Lisp_Object v1; 1207 Lisp_Object v1 = POP;
1686 BEFORE_POTENTIAL_GC ();
1687 v1 = POP;
1688 TOP = Fnarrow_to_region (TOP, v1); 1208 TOP = Fnarrow_to_region (TOP, v1);
1689 AFTER_POTENTIAL_GC ();
1690 NEXT; 1209 NEXT;
1691 } 1210 }
1692 1211
1693 CASE (Bwiden): 1212 CASE (Bwiden):
1694 BEFORE_POTENTIAL_GC ();
1695 PUSH (Fwiden ()); 1213 PUSH (Fwiden ());
1696 AFTER_POTENTIAL_GC ();
1697 NEXT; 1214 NEXT;
1698 1215
1699 CASE (Bend_of_line): 1216 CASE (Bend_of_line):
1700 BEFORE_POTENTIAL_GC ();
1701 TOP = Fend_of_line (TOP); 1217 TOP = Fend_of_line (TOP);
1702 AFTER_POTENTIAL_GC ();
1703 NEXT; 1218 NEXT;
1704 1219
1705 CASE (Bset_marker): 1220 CASE (Bset_marker):
1706 { 1221 {
1707 Lisp_Object v1, v2; 1222 Lisp_Object v2 = POP, v1 = POP;
1708 BEFORE_POTENTIAL_GC (); 1223 TOP = Fset_marker (TOP, v1, v2);
1709 v1 = POP;
1710 v2 = POP;
1711 TOP = Fset_marker (TOP, v2, v1);
1712 AFTER_POTENTIAL_GC ();
1713 NEXT; 1224 NEXT;
1714 } 1225 }
1715 1226
1716 CASE (Bmatch_beginning): 1227 CASE (Bmatch_beginning):
1717 BEFORE_POTENTIAL_GC ();
1718 TOP = Fmatch_beginning (TOP); 1228 TOP = Fmatch_beginning (TOP);
1719 AFTER_POTENTIAL_GC ();
1720 NEXT; 1229 NEXT;
1721 1230
1722 CASE (Bmatch_end): 1231 CASE (Bmatch_end):
1723 BEFORE_POTENTIAL_GC ();
1724 TOP = Fmatch_end (TOP); 1232 TOP = Fmatch_end (TOP);
1725 AFTER_POTENTIAL_GC ();
1726 NEXT; 1233 NEXT;
1727 1234
1728 CASE (Bupcase): 1235 CASE (Bupcase):
1729 BEFORE_POTENTIAL_GC ();
1730 TOP = Fupcase (TOP); 1236 TOP = Fupcase (TOP);
1731 AFTER_POTENTIAL_GC ();
1732 NEXT; 1237 NEXT;
1733 1238
1734 CASE (Bdowncase): 1239 CASE (Bdowncase):
1735 BEFORE_POTENTIAL_GC ();
1736 TOP = Fdowncase (TOP); 1240 TOP = Fdowncase (TOP);
1737 AFTER_POTENTIAL_GC ();
1738 NEXT; 1241 NEXT;
1739 1242
1740 CASE (Bstringeqlsign): 1243 CASE (Bstringeqlsign):
1741 { 1244 {
1742 Lisp_Object v1; 1245 Lisp_Object v1 = POP;
1743 BEFORE_POTENTIAL_GC ();
1744 v1 = POP;
1745 TOP = Fstring_equal (TOP, v1); 1246 TOP = Fstring_equal (TOP, v1);
1746 AFTER_POTENTIAL_GC ();
1747 NEXT; 1247 NEXT;
1748 } 1248 }
1749 1249
1750 CASE (Bstringlss): 1250 CASE (Bstringlss):
1751 { 1251 {
1752 Lisp_Object v1; 1252 Lisp_Object v1 = POP;
1753 BEFORE_POTENTIAL_GC ();
1754 v1 = POP;
1755 TOP = Fstring_lessp (TOP, v1); 1253 TOP = Fstring_lessp (TOP, v1);
1756 AFTER_POTENTIAL_GC ();
1757 NEXT; 1254 NEXT;
1758 } 1255 }
1759 1256
1760 CASE (Bequal): 1257 CASE (Bequal):
1761 { 1258 {
1762 Lisp_Object v1; 1259 Lisp_Object v1 = POP;
1763 v1 = POP;
1764 TOP = Fequal (TOP, v1); 1260 TOP = Fequal (TOP, v1);
1765 NEXT; 1261 NEXT;
1766 } 1262 }
1767 1263
1768 CASE (Bnthcdr): 1264 CASE (Bnthcdr):
1769 { 1265 {
1770 Lisp_Object v1; 1266 Lisp_Object v1 = POP;
1771 BEFORE_POTENTIAL_GC ();
1772 v1 = POP;
1773 TOP = Fnthcdr (TOP, v1); 1267 TOP = Fnthcdr (TOP, v1);
1774 AFTER_POTENTIAL_GC ();
1775 NEXT; 1268 NEXT;
1776 } 1269 }
1777 1270
1778 CASE (Belt): 1271 CASE (Belt):
1779 { 1272 {
1780 Lisp_Object v1, v2;
1781 if (CONSP (TOP)) 1273 if (CONSP (TOP))
1782 { 1274 {
1783 /* Exchange args and then do nth. */ 1275 /* Exchange args and then do nth. */
1784 EMACS_INT n; 1276 Lisp_Object v2 = POP, v1 = TOP;
1785 BEFORE_POTENTIAL_GC ();
1786 v2 = POP;
1787 v1 = TOP;
1788 CHECK_NUMBER (v2); 1277 CHECK_NUMBER (v2);
1789 AFTER_POTENTIAL_GC (); 1278 EMACS_INT n = XINT (v2);
1790 n = XINT (v2); 1279 immediate_quit = true;
1791 immediate_quit = 1;
1792 while (--n >= 0 && CONSP (v1)) 1280 while (--n >= 0 && CONSP (v1))
1793 v1 = XCDR (v1); 1281 v1 = XCDR (v1);
1794 immediate_quit = 0; 1282 immediate_quit = false;
1795 TOP = CAR (v1); 1283 TOP = CAR (v1);
1796 } 1284 }
1797 else 1285 else
1798 { 1286 {
1799 BEFORE_POTENTIAL_GC (); 1287 Lisp_Object v1 = POP;
1800 v1 = POP;
1801 TOP = Felt (TOP, v1); 1288 TOP = Felt (TOP, v1);
1802 AFTER_POTENTIAL_GC ();
1803 } 1289 }
1804 NEXT; 1290 NEXT;
1805 } 1291 }
1806 1292
1807 CASE (Bmember): 1293 CASE (Bmember):
1808 { 1294 {
1809 Lisp_Object v1; 1295 Lisp_Object v1 = POP;
1810 BEFORE_POTENTIAL_GC ();
1811 v1 = POP;
1812 TOP = Fmember (TOP, v1); 1296 TOP = Fmember (TOP, v1);
1813 AFTER_POTENTIAL_GC ();
1814 NEXT; 1297 NEXT;
1815 } 1298 }
1816 1299
1817 CASE (Bassq): 1300 CASE (Bassq):
1818 { 1301 {
1819 Lisp_Object v1; 1302 Lisp_Object v1 = POP;
1820 BEFORE_POTENTIAL_GC ();
1821 v1 = POP;
1822 TOP = Fassq (TOP, v1); 1303 TOP = Fassq (TOP, v1);
1823 AFTER_POTENTIAL_GC ();
1824 NEXT; 1304 NEXT;
1825 } 1305 }
1826 1306
1827 CASE (Bnreverse): 1307 CASE (Bnreverse):
1828 BEFORE_POTENTIAL_GC ();
1829 TOP = Fnreverse (TOP); 1308 TOP = Fnreverse (TOP);
1830 AFTER_POTENTIAL_GC ();
1831 NEXT; 1309 NEXT;
1832 1310
1833 CASE (Bsetcar): 1311 CASE (Bsetcar):
1834 { 1312 {
1835 Lisp_Object v1; 1313 Lisp_Object v1 = POP;
1836 BEFORE_POTENTIAL_GC ();
1837 v1 = POP;
1838 TOP = Fsetcar (TOP, v1); 1314 TOP = Fsetcar (TOP, v1);
1839 AFTER_POTENTIAL_GC ();
1840 NEXT; 1315 NEXT;
1841 } 1316 }
1842 1317
1843 CASE (Bsetcdr): 1318 CASE (Bsetcdr):
1844 { 1319 {
1845 Lisp_Object v1; 1320 Lisp_Object v1 = POP;
1846 BEFORE_POTENTIAL_GC ();
1847 v1 = POP;
1848 TOP = Fsetcdr (TOP, v1); 1321 TOP = Fsetcdr (TOP, v1);
1849 AFTER_POTENTIAL_GC ();
1850 NEXT; 1322 NEXT;
1851 } 1323 }
1852 1324
1853 CASE (Bcar_safe): 1325 CASE (Bcar_safe):
1854 { 1326 TOP = CAR_SAFE (TOP);
1855 Lisp_Object v1; 1327 NEXT;
1856 v1 = TOP;
1857 TOP = CAR_SAFE (v1);
1858 NEXT;
1859 }
1860 1328
1861 CASE (Bcdr_safe): 1329 CASE (Bcdr_safe):
1862 { 1330 TOP = CDR_SAFE (TOP);
1863 Lisp_Object v1; 1331 NEXT;
1864 v1 = TOP;
1865 TOP = CDR_SAFE (v1);
1866 NEXT;
1867 }
1868 1332
1869 CASE (Bnconc): 1333 CASE (Bnconc):
1870 BEFORE_POTENTIAL_GC ();
1871 DISCARD (1); 1334 DISCARD (1);
1872 TOP = Fnconc (2, &TOP); 1335 TOP = Fnconc (2, &TOP);
1873 AFTER_POTENTIAL_GC ();
1874 NEXT; 1336 NEXT;
1875 1337
1876 CASE (Bnumberp): 1338 CASE (Bnumberp):
1877 TOP = (NUMBERP (TOP) ? Qt : Qnil); 1339 TOP = NUMBERP (TOP) ? Qt : Qnil;
1878 NEXT; 1340 NEXT;
1879 1341
1880 CASE (Bintegerp): 1342 CASE (Bintegerp):
1881 TOP = INTEGERP (TOP) ? Qt : Qnil; 1343 TOP = INTEGERP (TOP) ? Qt : Qnil;
1882 NEXT; 1344 NEXT;
1883 1345
1884#ifdef BYTE_CODE_SAFE 1346#if BYTE_CODE_SAFE
1885 /* These are intentionally written using 'case' syntax, 1347 /* These are intentionally written using 'case' syntax,
1886 because they are incompatible with the threaded 1348 because they are incompatible with the threaded
1887 interpreter. */ 1349 interpreter. */
1888 1350
1889 case Bset_mark: 1351 case Bset_mark:
1890 BEFORE_POTENTIAL_GC ();
1891 error ("set-mark is an obsolete bytecode"); 1352 error ("set-mark is an obsolete bytecode");
1892 AFTER_POTENTIAL_GC ();
1893 break; 1353 break;
1894 case Bscan_buffer: 1354 case Bscan_buffer:
1895 BEFORE_POTENTIAL_GC ();
1896 error ("scan-buffer is an obsolete bytecode"); 1355 error ("scan-buffer is an obsolete bytecode");
1897 AFTER_POTENTIAL_GC ();
1898 break; 1356 break;
1899#endif 1357#endif
1900 1358
@@ -1905,7 +1363,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1905 call3 (Qerror, 1363 call3 (Qerror,
1906 build_string ("Invalid byte opcode: op=%s, ptr=%d"), 1364 build_string ("Invalid byte opcode: op=%s, ptr=%d"),
1907 make_number (op), 1365 make_number (op),
1908 make_number ((stack.pc - 1) - stack.byte_string_start)); 1366 make_number (pc - 1 - bytestr_data));
1909 1367
1910 /* Handy byte-codes for lexical binding. */ 1368 /* Handy byte-codes for lexical binding. */
1911 CASE (Bstack_ref1): 1369 CASE (Bstack_ref1):
@@ -1914,32 +1372,32 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1914 CASE (Bstack_ref4): 1372 CASE (Bstack_ref4):
1915 CASE (Bstack_ref5): 1373 CASE (Bstack_ref5):
1916 { 1374 {
1917 Lisp_Object *ptr = top - (op - Bstack_ref); 1375 Lisp_Object v1 = top[Bstack_ref - op];
1918 PUSH (*ptr); 1376 PUSH (v1);
1919 NEXT; 1377 NEXT;
1920 } 1378 }
1921 CASE (Bstack_ref6): 1379 CASE (Bstack_ref6):
1922 { 1380 {
1923 Lisp_Object *ptr = top - (FETCH); 1381 Lisp_Object v1 = top[- FETCH];
1924 PUSH (*ptr); 1382 PUSH (v1);
1925 NEXT; 1383 NEXT;
1926 } 1384 }
1927 CASE (Bstack_ref7): 1385 CASE (Bstack_ref7):
1928 { 1386 {
1929 Lisp_Object *ptr = top - (FETCH2); 1387 Lisp_Object v1 = top[- FETCH2];
1930 PUSH (*ptr); 1388 PUSH (v1);
1931 NEXT; 1389 NEXT;
1932 } 1390 }
1933 CASE (Bstack_set): 1391 CASE (Bstack_set):
1934 /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */ 1392 /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
1935 { 1393 {
1936 Lisp_Object *ptr = top - (FETCH); 1394 Lisp_Object *ptr = top - FETCH;
1937 *ptr = POP; 1395 *ptr = POP;
1938 NEXT; 1396 NEXT;
1939 } 1397 }
1940 CASE (Bstack_set2): 1398 CASE (Bstack_set2):
1941 { 1399 {
1942 Lisp_Object *ptr = top - (FETCH2); 1400 Lisp_Object *ptr = top - FETCH2;
1943 *ptr = POP; 1401 *ptr = POP;
1944 NEXT; 1402 NEXT;
1945 } 1403 }
@@ -1955,27 +1413,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1955 1413
1956 CASE_DEFAULT 1414 CASE_DEFAULT
1957 CASE (Bconstant): 1415 CASE (Bconstant):
1958#ifdef BYTE_CODE_SAFE 1416 if (BYTE_CODE_SAFE
1959 if (op < Bconstant) 1417 && ! (Bconstant <= op && op < Bconstant + const_length))
1960 { 1418 emacs_abort ();
1961 emacs_abort ();
1962 }
1963 if ((op -= Bconstant) >= const_length)
1964 {
1965 emacs_abort ();
1966 }
1967 PUSH (vectorp[op]);
1968#else
1969 PUSH (vectorp[op - Bconstant]); 1419 PUSH (vectorp[op - Bconstant]);
1970#endif
1971 NEXT; 1420 NEXT;
1972 } 1421 }
1973 } 1422 }
1974 1423
1975 exit: 1424 exit:
1976 1425
1977 byte_stack_list = byte_stack_list->next;
1978
1979 /* Binds and unbinds are supposed to be compiled balanced. */ 1426 /* Binds and unbinds are supposed to be compiled balanced. */
1980 if (SPECPDL_INDEX () != count) 1427 if (SPECPDL_INDEX () != count)
1981 { 1428 {
@@ -1984,9 +1431,25 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1984 error ("binding stack not balanced (serious byte compiler bug)"); 1431 error ("binding stack not balanced (serious byte compiler bug)");
1985 } 1432 }
1986 1433
1434 Lisp_Object result = TOP;
1435 SAFE_FREE ();
1987 return result; 1436 return result;
1988} 1437}
1989 1438
1439/* `args_template' has the same meaning as in exec_byte_code() above. */
1440Lisp_Object
1441get_byte_code_arity (Lisp_Object args_template)
1442{
1443 eassert (NATNUMP (args_template));
1444 EMACS_INT at = XINT (args_template);
1445 bool rest = (at & 128) != 0;
1446 int mandatory = at & 127;
1447 EMACS_INT nonrest = at >> 8;
1448
1449 return Fcons (make_number (mandatory),
1450 rest ? Qmany : make_number (nonrest));
1451}
1452
1990void 1453void
1991syms_of_bytecode (void) 1454syms_of_bytecode (void)
1992{ 1455{
@@ -2008,7 +1471,7 @@ The variable byte-code-meter indicates how often each byte opcode is used.
2008If a symbol has a property named `byte-code-meter' whose value is an 1471If a symbol has a property named `byte-code-meter' whose value is an
2009integer, it is incremented each time that symbol's function is called. */); 1472integer, it is incremented each time that symbol's function is called. */);
2010 1473
2011 byte_metering_on = 0; 1474 byte_metering_on = false;
2012 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); 1475 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
2013 DEFSYM (Qbyte_code_meter, "byte-code-meter"); 1476 DEFSYM (Qbyte_code_meter, "byte-code-meter");
2014 { 1477 {
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-18 19:10:03 +0000