aboutsummaryrefslogtreecommitdiffstats
path: root/src/bytecode.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bytecode.c')
-rw-r--r--src/bytecode.c209
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
5This file is part of GNU Emacs. 5This 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
290struct 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
324void
325relocate_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
392DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 311DEFUN ("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.
394The first argument, BYTESTR, is a string of byte code; 313The 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 {