diff options
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 209 |
1 files changed, 51 insertions, 158 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index c581ed6d982..a64bc171d14 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-2016 Free Software Foundation, | 2 | Copyright (C) 1985-1988, 1993, 2000-2017 Free Software Foundation, |
| 3 | Inc. | 3 | Inc. |
| 4 | 4 | ||
| 5 | This file is part of GNU Emacs. | 5 | This file is part of GNU Emacs. |
| @@ -280,68 +280,10 @@ enum byte_code_op | |||
| 280 | 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 */ |
| 281 | #endif | 281 | #endif |
| 282 | }; | 282 | }; |
| 283 | |||
| 284 | /* Whether to maintain a `top' and `bottom' field in the stack frame. */ | ||
| 285 | #define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE | ||
| 286 | |||
| 287 | /* Structure describing a value stack used during byte-code execution | ||
| 288 | in Fbyte_code. */ | ||
| 289 | |||
| 290 | struct byte_stack | ||
| 291 | { | ||
| 292 | /* Program counter. This points into the byte_string below | ||
| 293 | and is relocated when that string is relocated. */ | ||
| 294 | const unsigned char *pc; | ||
| 295 | |||
| 296 | /* Top and bottom of stack. The bottom points to an area of memory | ||
| 297 | allocated with alloca in Fbyte_code. */ | ||
| 298 | #if BYTE_MAINTAIN_TOP | ||
| 299 | Lisp_Object *top, *bottom; | ||
| 300 | #endif | ||
| 301 | |||
| 302 | /* The string containing the byte-code, and its current address. | ||
| 303 | Storing this here protects it from GC because mark_byte_stack | ||
| 304 | marks it. */ | ||
| 305 | Lisp_Object byte_string; | ||
| 306 | const unsigned char *byte_string_start; | ||
| 307 | |||
| 308 | /* Next entry in byte_stack_list. */ | ||
| 309 | struct byte_stack *next; | ||
| 310 | }; | ||
| 311 | |||
| 312 | /* A list of currently active byte-code execution value stacks. | ||
| 313 | Fbyte_code adds an entry to the head of this list before it starts | ||
| 314 | processing byte-code, and it removes the entry again when it is | ||
| 315 | done. Signaling an error truncates the list. | ||
| 316 | |||
| 317 | byte_stack_list is a macro defined in thread.h. */ | ||
| 318 | /* struct byte_stack *byte_stack_list; */ | ||
| 319 | |||
| 320 | |||
| 321 | /* Relocate program counters in the stacks on byte_stack_list. Called | ||
| 322 | when GC has completed. */ | ||
| 323 | |||
| 324 | void | ||
| 325 | relocate_byte_stack (struct byte_stack *stack) | ||
| 326 | { | ||
| 327 | for (; stack; stack = stack->next) | ||
| 328 | { | ||
| 329 | if (stack->byte_string_start != SDATA (stack->byte_string)) | ||
| 330 | { | ||
| 331 | ptrdiff_t offset = stack->pc - stack->byte_string_start; | ||
| 332 | stack->byte_string_start = SDATA (stack->byte_string); | ||
| 333 | stack->pc = stack->byte_string_start + offset; | ||
| 334 | } | ||
| 335 | } | ||
| 336 | } | ||
| 337 | |||
| 338 | 283 | ||
| 339 | /* Fetch the next byte from the bytecode stream. */ | 284 | /* Fetch the next byte from the bytecode stream. */ |
| 340 | #ifdef BYTE_CODE_SAFE | 285 | |
| 341 | #define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++) | 286 | #define FETCH (*pc++) |
| 342 | #else | ||
| 343 | #define FETCH *stack.pc++ | ||
| 344 | #endif | ||
| 345 | 287 | ||
| 346 | /* 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 |
| 347 | out of them. */ | 289 | out of them. */ |
| @@ -366,29 +308,6 @@ relocate_byte_stack (struct byte_stack *stack) | |||
| 366 | 308 | ||
| 367 | #define TOP (*top) | 309 | #define TOP (*top) |
| 368 | 310 | ||
| 369 | #define CHECK_RANGE(ARG) \ | ||
| 370 | (BYTE_CODE_SAFE && bytestr_length <= (ARG) ? emacs_abort () : (void) 0) | ||
| 371 | |||
| 372 | /* A version of the QUIT macro which makes sure that the stack top is | ||
| 373 | set before signaling `quit'. */ | ||
| 374 | #define BYTE_CODE_QUIT \ | ||
| 375 | do { \ | ||
| 376 | if (quitcounter++) \ | ||
| 377 | break; \ | ||
| 378 | maybe_gc (); \ | ||
| 379 | if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ | ||
| 380 | { \ | ||
| 381 | Lisp_Object flag = Vquit_flag; \ | ||
| 382 | Vquit_flag = Qnil; \ | ||
| 383 | if (EQ (Vthrow_on_input, flag)) \ | ||
| 384 | Fthrow (Vthrow_on_input, Qt); \ | ||
| 385 | quit (); \ | ||
| 386 | } \ | ||
| 387 | else if (pending_signals) \ | ||
| 388 | process_pending_signals (); \ | ||
| 389 | } while (0) | ||
| 390 | |||
| 391 | |||
| 392 | DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, | 311 | DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, |
| 393 | doc: /* Function used internally in byte-compiled code. | 312 | doc: /* Function used internally in byte-compiled code. |
| 394 | The first argument, BYTESTR, is a string of byte code; | 313 | The first argument, BYTESTR, is a string of byte code; |
| @@ -438,19 +357,18 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 438 | 357 | ||
| 439 | ptrdiff_t bytestr_length = SBYTES (bytestr); | 358 | ptrdiff_t bytestr_length = SBYTES (bytestr); |
| 440 | Lisp_Object *vectorp = XVECTOR (vector)->contents; | 359 | Lisp_Object *vectorp = XVECTOR (vector)->contents; |
| 441 | struct byte_stack stack; | ||
| 442 | 360 | ||
| 443 | stack.byte_string = bytestr; | 361 | unsigned char quitcounter = 1; |
| 444 | stack.pc = stack.byte_string_start = SDATA (bytestr); | ||
| 445 | unsigned char quitcounter = 0; | ||
| 446 | EMACS_INT stack_items = XFASTINT (maxdepth) + 1; | 362 | EMACS_INT stack_items = XFASTINT (maxdepth) + 1; |
| 447 | USE_SAFE_ALLOCA; | 363 | USE_SAFE_ALLOCA; |
| 448 | Lisp_Object *stack_base; | 364 | Lisp_Object *stack_base; |
| 449 | SAFE_ALLOCA_LISP (stack_base, stack_items); | 365 | SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length); |
| 450 | Lisp_Object *stack_lim = stack_base + stack_items; | 366 | Lisp_Object *stack_lim = stack_base + stack_items; |
| 451 | Lisp_Object *top = stack_base; | 367 | Lisp_Object *top = stack_base; |
| 452 | stack.next = byte_stack_list; | 368 | memcpy (stack_lim, SDATA (bytestr), bytestr_length); |
| 453 | byte_stack_list = &stack; | 369 | void *void_stack_lim = stack_lim; |
| 370 | unsigned char const *bytestr_data = void_stack_lim; | ||
| 371 | unsigned char const *pc = bytestr_data; | ||
| 454 | ptrdiff_t count = SPECPDL_INDEX (); | 372 | ptrdiff_t count = SPECPDL_INDEX (); |
| 455 | 373 | ||
| 456 | if (!NILP (args_template)) | 374 | if (!NILP (args_template)) |
| @@ -590,15 +508,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 590 | 508 | ||
| 591 | CASE (Bgotoifnil): | 509 | CASE (Bgotoifnil): |
| 592 | { | 510 | { |
| 593 | Lisp_Object v1; | 511 | Lisp_Object v1 = POP; |
| 594 | op = FETCH2; | 512 | op = FETCH2; |
| 595 | v1 = POP; | ||
| 596 | if (NILP (v1)) | 513 | if (NILP (v1)) |
| 597 | { | 514 | goto op_branch; |
| 598 | BYTE_CODE_QUIT; | ||
| 599 | CHECK_RANGE (op); | ||
| 600 | stack.pc = stack.byte_string_start + op; | ||
| 601 | } | ||
| 602 | NEXT; | 515 | NEXT; |
| 603 | } | 516 | } |
| 604 | 517 | ||
| @@ -753,86 +666,72 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 753 | NEXT; | 666 | NEXT; |
| 754 | 667 | ||
| 755 | CASE (Bgoto): | 668 | CASE (Bgoto): |
| 756 | BYTE_CODE_QUIT; | 669 | op = FETCH2; |
| 757 | op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ | 670 | op_branch: |
| 758 | CHECK_RANGE (op); | 671 | op -= pc - bytestr_data; |
| 759 | stack.pc = stack.byte_string_start + op; | 672 | op_relative_branch: |
| 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; | ||
| 760 | NEXT; | 685 | NEXT; |
| 761 | 686 | ||
| 762 | CASE (Bgotoifnonnil): | 687 | CASE (Bgotoifnonnil): |
| 763 | op = FETCH2; | 688 | op = FETCH2; |
| 764 | Lisp_Object v1 = POP; | 689 | if (!NILP (POP)) |
| 765 | if (!NILP (v1)) | 690 | goto op_branch; |
| 766 | { | ||
| 767 | BYTE_CODE_QUIT; | ||
| 768 | CHECK_RANGE (op); | ||
| 769 | stack.pc = stack.byte_string_start + op; | ||
| 770 | } | ||
| 771 | NEXT; | 691 | NEXT; |
| 772 | 692 | ||
| 773 | CASE (Bgotoifnilelsepop): | 693 | CASE (Bgotoifnilelsepop): |
| 774 | op = FETCH2; | 694 | op = FETCH2; |
| 775 | if (NILP (TOP)) | 695 | if (NILP (TOP)) |
| 776 | { | 696 | goto op_branch; |
| 777 | BYTE_CODE_QUIT; | 697 | DISCARD (1); |
| 778 | CHECK_RANGE (op); | ||
| 779 | stack.pc = stack.byte_string_start + op; | ||
| 780 | } | ||
| 781 | else DISCARD (1); | ||
| 782 | NEXT; | 698 | NEXT; |
| 783 | 699 | ||
| 784 | CASE (Bgotoifnonnilelsepop): | 700 | CASE (Bgotoifnonnilelsepop): |
| 785 | op = FETCH2; | 701 | op = FETCH2; |
| 786 | if (!NILP (TOP)) | 702 | if (!NILP (TOP)) |
| 787 | { | 703 | goto op_branch; |
| 788 | BYTE_CODE_QUIT; | 704 | DISCARD (1); |
| 789 | CHECK_RANGE (op); | ||
| 790 | stack.pc = stack.byte_string_start + op; | ||
| 791 | } | ||
| 792 | else DISCARD (1); | ||
| 793 | NEXT; | 705 | NEXT; |
| 794 | 706 | ||
| 795 | CASE (BRgoto): | 707 | CASE (BRgoto): |
| 796 | BYTE_CODE_QUIT; | 708 | op = FETCH - 128; |
| 797 | stack.pc += (int) *stack.pc - 127; | 709 | goto op_relative_branch; |
| 798 | NEXT; | ||
| 799 | 710 | ||
| 800 | CASE (BRgotoifnil): | 711 | CASE (BRgotoifnil): |
| 712 | op = FETCH - 128; | ||
| 801 | if (NILP (POP)) | 713 | if (NILP (POP)) |
| 802 | { | 714 | goto op_relative_branch; |
| 803 | BYTE_CODE_QUIT; | ||
| 804 | stack.pc += (int) *stack.pc - 128; | ||
| 805 | } | ||
| 806 | stack.pc++; | ||
| 807 | NEXT; | 715 | NEXT; |
| 808 | 716 | ||
| 809 | CASE (BRgotoifnonnil): | 717 | CASE (BRgotoifnonnil): |
| 718 | op = FETCH - 128; | ||
| 810 | if (!NILP (POP)) | 719 | if (!NILP (POP)) |
| 811 | { | 720 | goto op_relative_branch; |
| 812 | BYTE_CODE_QUIT; | ||
| 813 | stack.pc += (int) *stack.pc - 128; | ||
| 814 | } | ||
| 815 | stack.pc++; | ||
| 816 | NEXT; | 721 | NEXT; |
| 817 | 722 | ||
| 818 | CASE (BRgotoifnilelsepop): | 723 | CASE (BRgotoifnilelsepop): |
| 819 | op = *stack.pc++; | 724 | op = FETCH - 128; |
| 820 | if (NILP (TOP)) | 725 | if (NILP (TOP)) |
| 821 | { | 726 | goto op_relative_branch; |
| 822 | BYTE_CODE_QUIT; | 727 | DISCARD (1); |
| 823 | stack.pc += op - 128; | ||
| 824 | } | ||
| 825 | else DISCARD (1); | ||
| 826 | NEXT; | 728 | NEXT; |
| 827 | 729 | ||
| 828 | CASE (BRgotoifnonnilelsepop): | 730 | CASE (BRgotoifnonnilelsepop): |
| 829 | op = *stack.pc++; | 731 | op = FETCH - 128; |
| 830 | if (!NILP (TOP)) | 732 | if (!NILP (TOP)) |
| 831 | { | 733 | goto op_relative_branch; |
| 832 | BYTE_CODE_QUIT; | 734 | DISCARD (1); |
| 833 | stack.pc += op - 128; | ||
| 834 | } | ||
| 835 | else DISCARD (1); | ||
| 836 | NEXT; | 735 | NEXT; |
| 837 | 736 | ||
| 838 | CASE (Breturn): | 737 | CASE (Breturn): |
| @@ -892,15 +791,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 892 | if (sys_setjmp (c->jmp)) | 791 | if (sys_setjmp (c->jmp)) |
| 893 | { | 792 | { |
| 894 | struct handler *c = handlerlist; | 793 | struct handler *c = handlerlist; |
| 895 | int dest; | ||
| 896 | top = c->bytecode_top; | 794 | top = c->bytecode_top; |
| 897 | dest = c->bytecode_dest; | 795 | op = c->bytecode_dest; |
| 898 | handlerlist = c->next; | 796 | handlerlist = c->next; |
| 899 | PUSH (c->val); | 797 | PUSH (c->val); |
| 900 | CHECK_RANGE (dest); | 798 | goto op_branch; |
| 901 | /* Might have been re-set by longjmp! */ | ||
| 902 | stack.byte_string_start = SDATA (stack.byte_string); | ||
| 903 | stack.pc = stack.byte_string_start + dest; | ||
| 904 | } | 799 | } |
| 905 | 800 | ||
| 906 | NEXT; | 801 | NEXT; |
| @@ -914,7 +809,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 914 | { | 809 | { |
| 915 | Lisp_Object handler = POP; | 810 | Lisp_Object handler = POP; |
| 916 | /* Support for a function here is new in 24.4. */ | 811 | /* Support for a function here is new in 24.4. */ |
| 917 | record_unwind_protect (FUNCTIONP (handler) ? bcall0 : unwind_body, | 812 | record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore, |
| 918 | handler); | 813 | handler); |
| 919 | NEXT; | 814 | NEXT; |
| 920 | } | 815 | } |
| @@ -1343,9 +1238,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1343 | 1238 | ||
| 1344 | CASE (Bdowncase): | 1239 | CASE (Bdowncase): |
| 1345 | TOP = Fdowncase (TOP); | 1240 | TOP = Fdowncase (TOP); |
| 1346 | NEXT; | 1241 | NEXT; |
| 1347 | 1242 | ||
| 1348 | CASE (Bstringeqlsign): | 1243 | CASE (Bstringeqlsign): |
| 1349 | { | 1244 | { |
| 1350 | Lisp_Object v1 = POP; | 1245 | Lisp_Object v1 = POP; |
| 1351 | TOP = Fstring_equal (TOP, v1); | 1246 | TOP = Fstring_equal (TOP, v1); |
| @@ -1468,7 +1363,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1468 | call3 (Qerror, | 1363 | call3 (Qerror, |
| 1469 | build_string ("Invalid byte opcode: op=%s, ptr=%d"), | 1364 | build_string ("Invalid byte opcode: op=%s, ptr=%d"), |
| 1470 | make_number (op), | 1365 | make_number (op), |
| 1471 | make_number (stack.pc - 1 - stack.byte_string_start)); | 1366 | make_number (pc - 1 - bytestr_data)); |
| 1472 | 1367 | ||
| 1473 | /* Handy byte-codes for lexical binding. */ | 1368 | /* Handy byte-codes for lexical binding. */ |
| 1474 | CASE (Bstack_ref1): | 1369 | CASE (Bstack_ref1): |
| @@ -1528,8 +1423,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1528 | 1423 | ||
| 1529 | exit: | 1424 | exit: |
| 1530 | 1425 | ||
| 1531 | byte_stack_list = byte_stack_list->next; | ||
| 1532 | |||
| 1533 | /* Binds and unbinds are supposed to be compiled balanced. */ | 1426 | /* Binds and unbinds are supposed to be compiled balanced. */ |
| 1534 | if (SPECPDL_INDEX () != count) | 1427 | if (SPECPDL_INDEX () != count) |
| 1535 | { | 1428 | { |