Mercurial > emacs

comparison src/bytecode.c @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 58d2828adc19
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 /* Execution of byte code produced by bytecomp.el. 1 /* Execution of byte code produced by bytecomp.el.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003, 2004,
3 Free Software Foundation, Inc. 3 2005 Free Software Foundation, Inc.
4 4
5 This file is part of GNU Emacs. 5 This file is part of GNU Emacs.
6 6
7 GNU Emacs is free software; you can redistribute it and/or modify 7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by 8 it under the terms of the GNU General Public License as published by
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details. 15 GNU General Public License for more details.
16 16
17 You should have received a copy of the GNU General Public License 17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to 18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02111-1307, USA. 20 Boston, MA 02110-1301, USA.
21 21
22 hacked on by jwz@lucid.com 17-jun-91 22 hacked on by jwz@lucid.com 17-jun-91
23 o added a compile-time switch to turn on simple sanity checking; 23 o added a compile-time switch to turn on simple sanity checking;
24 o put back the obsolete byte-codes for error-detection; 24 o put back the obsolete byte-codes for error-detection;
25 o added a new instruction, unbind_all, which I will use for 25 o added a new instruction, unbind_all, which I will use for
37 #include <config.h> 37 #include <config.h>
38 #include "lisp.h" 38 #include "lisp.h"
39 #include "buffer.h" 39 #include "buffer.h"
40 #include "charset.h" 40 #include "charset.h"
41 #include "syntax.h" 41 #include "syntax.h"
42 #include "window.h"
42 43
43 #ifdef CHECK_FRAME_FONT 44 #ifdef CHECK_FRAME_FONT
44 #include "frame.h" 45 #include "frame.h"
45 #include "xterm.h" 46 #include "xterm.h"
46 #endif 47 #endif
283 which opcode this is, record the value of `stack', and walk 284 which opcode this is, record the value of `stack', and walk
284 up the stack in a debugger, stopping in frames of Fbyte_code. 285 up the stack in a debugger, stopping in frames of Fbyte_code.
285 The culprit is found in the frame of Fbyte_code where the 286 The culprit is found in the frame of Fbyte_code where the
286 address of its local variable `stack' is equal to the 287 address of its local variable `stack' is equal to the
287 recorded value of `stack' here. */ 288 recorded value of `stack' here. */
288 if (!stack->top) 289 eassert (stack->top);
289 abort ();
290 290
291 for (obj = stack->bottom; obj <= stack->top; ++obj) 291 for (obj = stack->bottom; obj <= stack->top; ++obj)
292 if (!XMARKBIT (*obj)) 292 mark_object (*obj);
293 { 293
294 mark_object (obj); 294 mark_object (stack->byte_string);
295 XMARK (*obj); 295 mark_object (stack->constants);
296 }
297
298 if (!XMARKBIT (stack->byte_string))
299 {
300 mark_object (&stack->byte_string);
301 XMARK (stack->byte_string);
302 }
303
304 if (!XMARKBIT (stack->constants))
305 {
306 mark_object (&stack->constants);
307 XMARK (stack->constants);
308 }
309 } 296 }
310 } 297 }
311 298
312 299
313 /* Unmark objects in the stacks on byte_stack_list. Relocate program 300 /* Unmark objects in the stacks on byte_stack_list. Relocate program
315 302
316 void 303 void
317 unmark_byte_stack () 304 unmark_byte_stack ()
318 { 305 {
319 struct byte_stack *stack; 306 struct byte_stack *stack;
320 Lisp_Object *obj;
321 307
322 for (stack = byte_stack_list; stack; stack = stack->next) 308 for (stack = byte_stack_list; stack; stack = stack->next)
323 { 309 {
324 for (obj = stack->bottom; obj <= stack->top; ++obj)
325 XUNMARK (*obj);
326
327 XUNMARK (stack->byte_string);
328 XUNMARK (stack->constants);
329
330 if (stack->byte_string_start != SDATA (stack->byte_string)) 310 if (stack->byte_string_start != SDATA (stack->byte_string))
331 { 311 {
332 int offset = stack->pc - stack->byte_string_start; 312 int offset = stack->pc - stack->byte_string_start;
333 stack->byte_string_start = SDATA (stack->byte_string); 313 stack->byte_string_start = SDATA (stack->byte_string);
334 stack->pc = stack->byte_string_start + offset; 314 stack->pc = stack->byte_string_start + offset;
373 #define AFTER_POTENTIAL_GC() stack.top = NULL 353 #define AFTER_POTENTIAL_GC() stack.top = NULL
374 354
375 /* Garbage collect if we have consed enough since the last time. 355 /* Garbage collect if we have consed enough since the last time.
376 We do this at every branch, to avoid loops that never GC. */ 356 We do this at every branch, to avoid loops that never GC. */
377 357
378 #define MAYBE_GC() \ 358 #define MAYBE_GC() \
379 if (consing_since_gc > gc_cons_threshold) \ 359 if (consing_since_gc > gc_cons_threshold \
380 { \ 360 && consing_since_gc > gc_relative_threshold) \
381 BEFORE_POTENTIAL_GC (); \ 361 { \
382 Fgarbage_collect (); \ 362 BEFORE_POTENTIAL_GC (); \
383 AFTER_POTENTIAL_GC (); \ 363 Fgarbage_collect (); \
384 } \ 364 AFTER_POTENTIAL_GC (); \
365 } \
385 else 366 else
386 367
387 /* Check for jumping out of range. */ 368 /* Check for jumping out of range. */
388 369
389 #ifdef BYTE_CODE_SAFE 370 #ifdef BYTE_CODE_SAFE
402 383
403 #define BYTE_CODE_QUIT \ 384 #define BYTE_CODE_QUIT \
404 do { \ 385 do { \
405 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ 386 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
406 { \ 387 { \
388 Lisp_Object flag = Vquit_flag; \
407 Vquit_flag = Qnil; \ 389 Vquit_flag = Qnil; \
408 BEFORE_POTENTIAL_GC (); \ 390 BEFORE_POTENTIAL_GC (); \
391 if (EQ (Vthrow_on_input, flag)) \
392 Fthrow (Vthrow_on_input, Qt); \
409 Fsignal (Qquit, Qnil); \ 393 Fsignal (Qquit, Qnil); \
394 AFTER_POTENTIAL_GC (); \
410 } \ 395 } \
411 } while (0) 396 } while (0)
412 397
413 398
414 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 399 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
537 PUSH (v2); 522 PUSH (v2);
538 break; 523 break;
539 } 524 }
540 525
541 case Bgotoifnil: 526 case Bgotoifnil:
542 MAYBE_GC (); 527 {
543 op = FETCH2; 528 Lisp_Object v1;
544 if (NILP (POP)) 529 MAYBE_GC ();
545 { 530 op = FETCH2;
546 BYTE_CODE_QUIT; 531 v1 = POP;
547 CHECK_RANGE (op); 532 if (NILP (v1))
548 stack.pc = stack.byte_string_start + op; 533 {
549 } 534 BYTE_CODE_QUIT;
550 break; 535 CHECK_RANGE (op);
536 stack.pc = stack.byte_string_start + op;
537 }
538 break;
539 }
551 540
552 case Bcar: 541 case Bcar:
553 { 542 {
554 Lisp_Object v1; 543 Lisp_Object v1;
555 v1 = TOP; 544 v1 = TOP;
557 TOP = XCAR (v1); 546 TOP = XCAR (v1);
558 else if (NILP (v1)) 547 else if (NILP (v1))
559 TOP = Qnil; 548 TOP = Qnil;
560 else 549 else
561 { 550 {
562 BEFORE_POTENTIAL_GC (); 551 wrong_type_argument (Qlistp, v1);
563 Fcar (wrong_type_argument (Qlistp, v1));
564 AFTER_POTENTIAL_GC ();
565 } 552 }
566 break; 553 break;
567 } 554 }
568 555
569 case Beq: 556 case Beq:
592 TOP = XCDR (v1); 579 TOP = XCDR (v1);
593 else if (NILP (v1)) 580 else if (NILP (v1))
594 TOP = Qnil; 581 TOP = Qnil;
595 else 582 else
596 { 583 {
597 BEFORE_POTENTIAL_GC (); 584 wrong_type_argument (Qlistp, v1);
598 Fcdr (wrong_type_argument (Qlistp, v1));
599 AFTER_POTENTIAL_GC ();
600 } 585 }
601 break; 586 break;
602 } 587 }
603 588
604 case Bvarset: 589 case Bvarset:
635 BEFORE_POTENTIAL_GC (); 620 BEFORE_POTENTIAL_GC ();
636 set_internal (sym, val, current_buffer, 0); 621 set_internal (sym, val, current_buffer, 0);
637 AFTER_POTENTIAL_GC (); 622 AFTER_POTENTIAL_GC ();
638 } 623 }
639 } 624 }
640 POP; 625 (void) POP;
641 break; 626 break;
642 627
643 case Bdup: 628 case Bdup:
644 { 629 {
645 Lisp_Object v1; 630 Lisp_Object v1;
747 CHECK_RANGE (op); 732 CHECK_RANGE (op);
748 stack.pc = stack.byte_string_start + op; 733 stack.pc = stack.byte_string_start + op;
749 break; 734 break;
750 735
751 case Bgotoifnonnil: 736 case Bgotoifnonnil:
752 MAYBE_GC (); 737 {
753 op = FETCH2; 738 Lisp_Object v1;
754 if (!NILP (POP)) 739 MAYBE_GC ();
755 { 740 op = FETCH2;
756 BYTE_CODE_QUIT; 741 v1 = POP;
757 CHECK_RANGE (op); 742 if (!NILP (v1))
758 stack.pc = stack.byte_string_start + op; 743 {
759 } 744 BYTE_CODE_QUIT;
760 break; 745 CHECK_RANGE (op);
746 stack.pc = stack.byte_string_start + op;
747 }
748 break;
749 }
761 750
762 case Bgotoifnilelsepop: 751 case Bgotoifnilelsepop:
763 MAYBE_GC (); 752 MAYBE_GC ();
764 op = FETCH2; 753 op = FETCH2;
765 if (NILP (TOP)) 754 if (NILP (TOP))
788 BYTE_CODE_QUIT; 777 BYTE_CODE_QUIT;
789 stack.pc += (int) *stack.pc - 127; 778 stack.pc += (int) *stack.pc - 127;
790 break; 779 break;
791 780
792 case BRgotoifnil: 781 case BRgotoifnil:
793 MAYBE_GC (); 782 {
794 if (NILP (POP)) 783 Lisp_Object v1;
795 { 784 MAYBE_GC ();
796 BYTE_CODE_QUIT; 785 v1 = POP;
797 stack.pc += (int) *stack.pc - 128; 786 if (NILP (v1))
798 } 787 {
799 stack.pc++; 788 BYTE_CODE_QUIT;
800 break; 789 stack.pc += (int) *stack.pc - 128;
790 }
791 stack.pc++;
792 break;
793 }
801 794
802 case BRgotoifnonnil: 795 case BRgotoifnonnil:
803 MAYBE_GC (); 796 {
804 if (!NILP (POP)) 797 Lisp_Object v1;
805 { 798 MAYBE_GC ();
806 BYTE_CODE_QUIT; 799 v1 = POP;
807 stack.pc += (int) *stack.pc - 128; 800 if (!NILP (v1))
808 } 801 {
809 stack.pc++; 802 BYTE_CODE_QUIT;
810 break; 803 stack.pc += (int) *stack.pc - 128;
804 }
805 stack.pc++;
806 break;
807 }
811 808
812 case BRgotoifnilelsepop: 809 case BRgotoifnilelsepop:
813 MAYBE_GC (); 810 MAYBE_GC ();
814 op = *stack.pc++; 811 op = *stack.pc++;
815 if (NILP (TOP)) 812 if (NILP (TOP))
873 AFTER_POTENTIAL_GC (); 870 AFTER_POTENTIAL_GC ();
874 break; 871 break;
875 } 872 }
876 873
877 case Bunwind_protect: 874 case Bunwind_protect:
878 /* The function record_unwind_protect can GC. */ 875 record_unwind_protect (Fprogn, POP);
879 BEFORE_POTENTIAL_GC ();
880 record_unwind_protect (0, POP);
881 AFTER_POTENTIAL_GC ();
882 (specpdl_ptr - 1)->symbol = Qnil;
883 break; 876 break;
884 877
885 case Bcondition_case: 878 case Bcondition_case:
886 { 879 {
887 Lisp_Object v1; 880 Lisp_Object handlers, body;
888 v1 = POP; 881 handlers = POP;
889 v1 = Fcons (POP, v1); 882 body = POP;
890 BEFORE_POTENTIAL_GC (); 883 BEFORE_POTENTIAL_GC ();
891 TOP = Fcondition_case (Fcons (TOP, v1)); 884 TOP = internal_lisp_condition_case (TOP, body, handlers);
892 AFTER_POTENTIAL_GC (); 885 AFTER_POTENTIAL_GC ();
893 break; 886 break;
894 } 887 }
895 888
896 case Btemp_output_buffer_setup: 889 case Btemp_output_buffer_setup:
929 if (CONSP (v1)) 922 if (CONSP (v1))
930 v1 = XCDR (v1); 923 v1 = XCDR (v1);
931 else if (!NILP (v1)) 924 else if (!NILP (v1))
932 { 925 {
933 immediate_quit = 0; 926 immediate_quit = 0;
934 BEFORE_POTENTIAL_GC (); 927 wrong_type_argument (Qlistp, v1);
935 v1 = wrong_type_argument (Qlistp, v1);
936 AFTER_POTENTIAL_GC ();
937 immediate_quit = 1;
938 op++;
939 } 928 }
940 } 929 }
941 immediate_quit = 0; 930 immediate_quit = 0;
942 if (CONSP (v1)) 931 if (CONSP (v1))
943 TOP = XCAR (v1); 932 TOP = XCAR (v1);
944 else if (NILP (v1)) 933 else if (NILP (v1))
945 TOP = Qnil; 934 TOP = Qnil;
946 else 935 else
947 { 936 wrong_type_argument (Qlistp, v1);
948 BEFORE_POTENTIAL_GC ();
949 Fcar (wrong_type_argument (Qlistp, v1));
950 AFTER_POTENTIAL_GC ();
951 }
952 break; 937 break;
953 } 938 }
954 939
955 case Bsymbolp: 940 case Bsymbolp:
956 TOP = SYMBOLP (TOP) ? Qt : Qnil; 941 TOP = SYMBOLP (TOP) ? Qt : Qnil;
1576 if (CONSP (v1)) 1561 if (CONSP (v1))
1577 v1 = XCDR (v1); 1562 v1 = XCDR (v1);
1578 else if (!NILP (v1)) 1563 else if (!NILP (v1))
1579 { 1564 {
1580 immediate_quit = 0; 1565 immediate_quit = 0;
1581 BEFORE_POTENTIAL_GC (); 1566 wrong_type_argument (Qlistp, v1);
1582 v1 = wrong_type_argument (Qlistp, v1);
1583 AFTER_POTENTIAL_GC ();
1584 immediate_quit = 1;
1585 op++;
1586 } 1567 }
1587 } 1568 }
1588 immediate_quit = 0; 1569 immediate_quit = 0;
1589 if (CONSP (v1)) 1570 if (CONSP (v1))
1590 TOP = XCAR (v1); 1571 TOP = XCAR (v1);
1591 else if (NILP (v1)) 1572 else if (NILP (v1))
1592 TOP = Qnil; 1573 TOP = Qnil;
1593 else 1574 else
1594 { 1575 wrong_type_argument (Qlistp, v1);
1595 BEFORE_POTENTIAL_GC ();
1596 Fcar (wrong_type_argument (Qlistp, v1));
1597 AFTER_POTENTIAL_GC ();
1598 }
1599 } 1576 }
1600 else 1577 else
1601 { 1578 {
1602 BEFORE_POTENTIAL_GC (); 1579 BEFORE_POTENTIAL_GC ();
1603 v1 = POP; 1580 v1 = POP;
1773 XVECTOR (Vbyte_code_meter)->contents[i] = 1750 XVECTOR (Vbyte_code_meter)->contents[i] =
1774 Fmake_vector (make_number (256), make_number (0)); 1751 Fmake_vector (make_number (256), make_number (0));
1775 } 1752 }
1776 #endif 1753 #endif
1777 } 1754 }
1755
1756 /* arch-tag: b9803b6f-1ed6-4190-8adf-33fd3a9d10e9
1757 (do not change this comment) */