aboutsummaryrefslogtreecommitdiffstats
path: root/src/bytecode.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bytecode.c')
-rw-r--r--src/bytecode.c188
1 files changed, 44 insertions, 144 deletions
diff --git a/src/bytecode.c b/src/bytecode.c
index 0c5b8494d0c..995d37c09d5 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -281,59 +281,9 @@ enum byte_code_op
281#endif 281#endif
282}; 282};
283 283
284/* Structure describing a value stack used during byte-code execution
285 in Fbyte_code. */
286
287struct byte_stack
288{
289 /* Program counter. This points into the byte_string below
290 and is relocated when that string is relocated. */
291 const unsigned char *pc;
292
293 /* The string containing the byte-code, and its current address.
294 Storing this here protects it from GC. */
295 Lisp_Object byte_string;
296 const unsigned char *byte_string_start;
297
298 /* Next entry in byte_stack_list. */
299 struct byte_stack *next;
300};
301
302/* A list of currently active byte-code execution value stacks.
303 Fbyte_code adds an entry to the head of this list before it starts
304 processing byte-code, and it removes the entry again when it is
305 done. Signaling an error truncates the list. */
306
307struct byte_stack *byte_stack_list;
308
309
310/* Relocate program counters in the stacks on byte_stack_list. Called
311 when GC has completed. */
312
313void
314relocate_byte_stack (void)
315{
316 struct byte_stack *stack;
317
318 for (stack = byte_stack_list; stack; stack = stack->next)
319 {
320 if (stack->byte_string_start != SDATA (stack->byte_string))
321 {
322 ptrdiff_t offset = stack->pc - stack->byte_string_start;
323 stack->byte_string_start = SDATA (stack->byte_string);
324 stack->pc = stack->byte_string_start + offset;
325 }
326 }
327}
328
329
330/* Fetch the next byte from the bytecode stream. */ 284/* Fetch the next byte from the bytecode stream. */
331 285
332#if BYTE_CODE_SAFE 286#define FETCH (*pc++)
333#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++)
334#else
335#define FETCH *stack.pc++
336#endif
337 287
338/* 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
339 out of them. */ 289 out of them. */
@@ -358,32 +308,6 @@ relocate_byte_stack (void)
358 308
359#define TOP (*top) 309#define TOP (*top)
360 310
361/* Check for jumping out of range. */
362
363#define CHECK_RANGE(ARG) \
364 (BYTE_CODE_SAFE && bytestr_length <= (ARG) ? emacs_abort () : (void) 0)
365
366/* A version of the QUIT macro which makes sure that the stack top is
367 set before signaling `quit'. */
368
369#define BYTE_CODE_QUIT \
370 do { \
371 if (quitcounter++) \
372 break; \
373 maybe_gc (); \
374 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
375 { \
376 Lisp_Object flag = Vquit_flag; \
377 Vquit_flag = Qnil; \
378 if (EQ (Vthrow_on_input, flag)) \
379 Fthrow (Vthrow_on_input, Qt); \
380 quit (); \
381 } \
382 else if (pending_signals) \
383 process_pending_signals (); \
384 } while (0)
385
386
387DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 311DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
388 doc: /* Function used internally in byte-compiled code. 312 doc: /* Function used internally in byte-compiled code.
389The first argument, BYTESTR, is a string of byte code; 313The first argument, BYTESTR, is a string of byte code;
@@ -423,7 +347,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
423 Lisp_Object *vectorp; 347 Lisp_Object *vectorp;
424 ptrdiff_t const_length; 348 ptrdiff_t const_length;
425 ptrdiff_t bytestr_length; 349 ptrdiff_t bytestr_length;
426 struct byte_stack stack;
427 Lisp_Object *top; 350 Lisp_Object *top;
428 Lisp_Object result; 351 Lisp_Object result;
429 enum handlertype type; 352 enum handlertype type;
@@ -445,16 +368,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
445 bytestr_length = SBYTES (bytestr); 368 bytestr_length = SBYTES (bytestr);
446 vectorp = XVECTOR (vector)->contents; 369 vectorp = XVECTOR (vector)->contents;
447 370
448 stack.byte_string = bytestr; 371 unsigned char quitcounter = 1;
449 stack.pc = stack.byte_string_start = SDATA (bytestr);
450 unsigned char quitcounter = 0;
451 EMACS_INT stack_items = XFASTINT (maxdepth) + 1; 372 EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
452 Lisp_Object *stack_base; 373 Lisp_Object *stack_base;
453 SAFE_ALLOCA_LISP (stack_base, stack_items); 374 SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length);
454 Lisp_Object *stack_lim = stack_base + stack_items; 375 Lisp_Object *stack_lim = stack_base + stack_items;
455 top = stack_base; 376 top = stack_base;
456 stack.next = byte_stack_list; 377 memcpy (stack_lim, SDATA (bytestr), bytestr_length);
457 byte_stack_list = &stack; 378 void *void_stack_lim = stack_lim;
379 unsigned char const *bytestr_data = void_stack_lim;
380 unsigned char const *pc = bytestr_data;
458 ptrdiff_t count = SPECPDL_INDEX (); 381 ptrdiff_t count = SPECPDL_INDEX ();
459 382
460 if (!NILP (args_template)) 383 if (!NILP (args_template))
@@ -608,11 +531,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
608 op = FETCH2; 531 op = FETCH2;
609 v1 = POP; 532 v1 = POP;
610 if (NILP (v1)) 533 if (NILP (v1))
611 { 534 goto op_branch;
612 BYTE_CODE_QUIT;
613 CHECK_RANGE (op);
614 stack.pc = stack.byte_string_start + op;
615 }
616 NEXT; 535 NEXT;
617 } 536 }
618 537
@@ -791,10 +710,22 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
791 NEXT; 710 NEXT;
792 711
793 CASE (Bgoto): 712 CASE (Bgoto):
794 BYTE_CODE_QUIT; 713 op = FETCH2;
795 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ 714 op_branch:
796 CHECK_RANGE (op); 715 op -= pc - bytestr_data;
797 stack.pc = stack.byte_string_start + op; 716 op_relative_branch:
717 if (BYTE_CODE_SAFE
718 && ! (bytestr_data - pc <= op
719 && op < bytestr_data + bytestr_length - pc))
720 emacs_abort ();
721 quitcounter += op < 0;
722 if (!quitcounter)
723 {
724 quitcounter = 1;
725 maybe_gc ();
726 QUIT;
727 }
728 pc += op;
798 NEXT; 729 NEXT;
799 730
800 CASE (Bgotoifnonnil): 731 CASE (Bgotoifnonnil):
@@ -803,51 +734,35 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
803 op = FETCH2; 734 op = FETCH2;
804 v1 = POP; 735 v1 = POP;
805 if (!NILP (v1)) 736 if (!NILP (v1))
806 { 737 goto op_branch;
807 BYTE_CODE_QUIT;
808 CHECK_RANGE (op);
809 stack.pc = stack.byte_string_start + op;
810 }
811 NEXT; 738 NEXT;
812 } 739 }
813 740
814 CASE (Bgotoifnilelsepop): 741 CASE (Bgotoifnilelsepop):
815 op = FETCH2; 742 op = FETCH2;
816 if (NILP (TOP)) 743 if (NILP (TOP))
817 { 744 goto op_branch;
818 BYTE_CODE_QUIT; 745 DISCARD (1);
819 CHECK_RANGE (op);
820 stack.pc = stack.byte_string_start + op;
821 }
822 else DISCARD (1);
823 NEXT; 746 NEXT;
824 747
825 CASE (Bgotoifnonnilelsepop): 748 CASE (Bgotoifnonnilelsepop):
826 op = FETCH2; 749 op = FETCH2;
827 if (!NILP (TOP)) 750 if (!NILP (TOP))
828 { 751 goto op_branch;
829 BYTE_CODE_QUIT; 752 DISCARD (1);
830 CHECK_RANGE (op);
831 stack.pc = stack.byte_string_start + op;
832 }
833 else DISCARD (1);
834 NEXT; 753 NEXT;
835 754
836 CASE (BRgoto): 755 CASE (BRgoto):
837 BYTE_CODE_QUIT; 756 op = FETCH - 128;
838 stack.pc += (int) *stack.pc - 127; 757 goto op_relative_branch;
839 NEXT;
840 758
841 CASE (BRgotoifnil): 759 CASE (BRgotoifnil):
842 { 760 {
843 Lisp_Object v1; 761 Lisp_Object v1;
844 v1 = POP; 762 v1 = POP;
763 op = FETCH - 128;
845 if (NILP (v1)) 764 if (NILP (v1))
846 { 765 goto op_relative_branch;
847 BYTE_CODE_QUIT;
848 stack.pc += (int) *stack.pc - 128;
849 }
850 stack.pc++;
851 NEXT; 766 NEXT;
852 } 767 }
853 768
@@ -855,33 +770,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
855 { 770 {
856 Lisp_Object v1; 771 Lisp_Object v1;
857 v1 = POP; 772 v1 = POP;
773 op = FETCH - 128;
858 if (!NILP (v1)) 774 if (!NILP (v1))
859 { 775 goto op_relative_branch;
860 BYTE_CODE_QUIT;
861 stack.pc += (int) *stack.pc - 128;
862 }
863 stack.pc++;
864 NEXT; 776 NEXT;
865 } 777 }
866 778
867 CASE (BRgotoifnilelsepop): 779 CASE (BRgotoifnilelsepop):
868 op = *stack.pc++; 780 op = FETCH - 128;
869 if (NILP (TOP)) 781 if (NILP (TOP))
870 { 782 goto op_relative_branch;
871 BYTE_CODE_QUIT; 783 DISCARD (1);
872 stack.pc += op - 128;
873 }
874 else DISCARD (1);
875 NEXT; 784 NEXT;
876 785
877 CASE (BRgotoifnonnilelsepop): 786 CASE (BRgotoifnonnilelsepop):
878 op = *stack.pc++; 787 op = FETCH - 128;
879 if (!NILP (TOP)) 788 if (!NILP (TOP))
880 { 789 goto op_relative_branch;
881 BYTE_CODE_QUIT; 790 DISCARD (1);
882 stack.pc += op - 128;
883 }
884 else DISCARD (1);
885 NEXT; 791 NEXT;
886 792
887 CASE (Breturn): 793 CASE (Breturn):
@@ -946,15 +852,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
946 if (sys_setjmp (c->jmp)) 852 if (sys_setjmp (c->jmp))
947 { 853 {
948 struct handler *c = handlerlist; 854 struct handler *c = handlerlist;
949 int dest;
950 top = c->bytecode_top; 855 top = c->bytecode_top;
951 dest = c->bytecode_dest; 856 op = c->bytecode_dest;
952 handlerlist = c->next; 857 handlerlist = c->next;
953 PUSH (c->val); 858 PUSH (c->val);
954 CHECK_RANGE (dest); 859 goto op_branch;
955 /* Might have been re-set by longjmp! */
956 stack.byte_string_start = SDATA (stack.byte_string);
957 stack.pc = stack.byte_string_start + dest;
958 } 860 }
959 861
960 NEXT; 862 NEXT;
@@ -1629,7 +1531,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1629 call3 (Qerror, 1531 call3 (Qerror,
1630 build_string ("Invalid byte opcode: op=%s, ptr=%d"), 1532 build_string ("Invalid byte opcode: op=%s, ptr=%d"),
1631 make_number (op), 1533 make_number (op),
1632 make_number ((stack.pc - 1) - stack.byte_string_start)); 1534 make_number (pc - 1 - bytestr_data));
1633 1535
1634 /* Handy byte-codes for lexical binding. */ 1536 /* Handy byte-codes for lexical binding. */
1635 CASE (Bstack_ref1): 1537 CASE (Bstack_ref1):
@@ -1689,8 +1591,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1689 1591
1690 exit: 1592 exit:
1691 1593
1692 byte_stack_list = byte_stack_list->next;
1693
1694 /* Binds and unbinds are supposed to be compiled balanced. */ 1594 /* Binds and unbinds are supposed to be compiled balanced. */
1695 if (SPECPDL_INDEX () != count) 1595 if (SPECPDL_INDEX () != count)
1696 { 1596 {