Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 1920:c66036f59678

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-02-20 07:29:16 by stephent] GCPRO documentation <87y8qynrj0.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Fri, 20 Feb 2004 07:29:23 +0000
parents 3d25fd3d9ac4
children 9c872f33ecbe
comparison
equal deleted inserted replaced
1919:9bde73b8c020 1920:c66036f59678
445 445
446 /* Get the value which is at the top of the execution stack, 446 /* Get the value which is at the top of the execution stack,
447 but don't pop it. */ 447 but don't pop it. */
448 #define TOP (*stack_ptr) 448 #define TOP (*stack_ptr)
449 449
450 /* See comment before the big switch in execute_optimized_program(). */
450 #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg) 451 #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg)
451 452
452 /* The actual interpreter for byte code. 453 /* The actual interpreter for byte code.
453 This function has been seriously optimized for performance. 454 This function has been seriously optimized for performance.
454 Don't change the constructs unless you are willing to do 455 Don't change the constructs unless you are willing to do
474 475
475 #ifdef ERROR_CHECK_BYTE_CODE 476 #ifdef ERROR_CHECK_BYTE_CODE
476 Lisp_Object *stack_end = stack_beg + stack_depth; 477 Lisp_Object *stack_end = stack_beg + stack_depth;
477 #endif 478 #endif
478 479
479 #if STATIC_GCPRO_STACK 480 /* We used to GCPRO the whole interpreter stack before entering this while
480 /* Initialize all the objects on the stack to Qnil, 481 loop (21.5.14 and before), but that interferes with collection of weakly
481 so we can GCPRO the whole stack. 482 referenced objects. Although strictly speaking there's no promise that
482 The first element of the stack is actually a dummy. */ 483 weak references will disappear by any given point in time, they should
483 { 484 be collected at the first opportunity. Waiting until exit from the
484 int i; 485 function caused test failures because "stale" objects "above" the top of
485 Lisp_Object *p; 486 the stack were still GCPROed, and they were not getting collected until
486 for (i = stack_depth, p = stack_ptr; i--;) 487 after exit from the (byte-compiled) test!
487 *++p = Qnil; 488
488 } 489 Now the idea is to dynamically adjust the array of GCPROed objects to
489 #endif 490 include only the "active" region of the stack.
491
492 We use the "GCPRO1 the array base and set the nvars member" method. It
493 would be slightly inefficient but correct to use GCPRO1_ARRAY here. It
494 would just redundantly set nvars.
495 #### Maybe it would be clearer to use GCPRO1_ARRAY and do GCPRO_STACK
496 after the switch?
497
498 GCPRO_STACK is something of a misnomer, because it suggests that a
499 struct gcpro is initialized each time. This is false; only the nvars
500 member of a single struct gcpro is being adjusted. This works because
501 each time a new object is assigned to a stack location, the old object
502 loses its reference and is effectively UNGCPROed, and the new object is
503 automatically GCPROed as long as nvars is correct. Only when we
504 return from the interpreter do we need to finalize the struct gcpro
505 itself, and that's done at case Breturn.
506 */
490 GCPRO1 (stack_ptr[1]); 507 GCPRO1 (stack_ptr[1]);
491 #if STATIC_GCPRO_STACK
492 gcpro1.nvars = stack_depth;
493 #endif
494 508
495 while (1) 509 while (1)
496 { 510 {
497 REGISTER Opcode opcode = (Opcode) READ_UINT_1; 511 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
512
513 GCPRO_STACK; /* Get nvars right before maybe signaling. */
498 #ifdef ERROR_CHECK_BYTE_CODE 514 #ifdef ERROR_CHECK_BYTE_CODE
499 if (stack_ptr > stack_end) 515 if (stack_ptr > stack_end)
500 stack_overflow ("byte code stack overflow", Qunbound); 516 stack_overflow ("byte code stack overflow", Qunbound);
501 if (stack_ptr < stack_beg) 517 if (stack_ptr < stack_beg)
502 stack_overflow ("byte code stack underflow", Qunbound); 518 stack_overflow ("byte code stack underflow", Qunbound);
506 prev_opcode = this_opcode; 522 prev_opcode = this_opcode;
507 this_opcode = opcode; 523 this_opcode = opcode;
508 meter_code (prev_opcode, this_opcode); 524 meter_code (prev_opcode, this_opcode);
509 #endif 525 #endif
510 526
511 #if !STATIC_GCPRO_STACK
512 GCPRO_STACK;
513 #endif
514 switch (opcode) 527 switch (opcode)
515 { 528 {
516 REGISTER int n; 529 REGISTER int n;
517 530
518 default: 531 default:
537 do_varref: 550 do_varref:
538 { 551 {
539 Lisp_Object symbol = constants_data[n]; 552 Lisp_Object symbol = constants_data[n];
540 Lisp_Object value = XSYMBOL (symbol)->value; 553 Lisp_Object value = XSYMBOL (symbol)->value;
541 if (SYMBOL_VALUE_MAGIC_P (value)) 554 if (SYMBOL_VALUE_MAGIC_P (value))
555 /* I GCPRO_STACKed Fsymbol_value elsewhere, but I dunno why. */
556 /* GCPRO_STACK; */
542 value = Fsymbol_value (symbol); 557 value = Fsymbol_value (symbol);
543 PUSH (value); 558 PUSH (value);
544 break; 559 break;
545 } 560 }
546 561
614 case Bcall+5: 629 case Bcall+5:
615 case Bcall+6: 630 case Bcall+6:
616 case Bcall+7: 631 case Bcall+7:
617 n = (opcode < Bcall+6 ? opcode - Bcall : 632 n = (opcode < Bcall+6 ? opcode - Bcall :
618 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2); 633 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
634 /* #### Shouldn't this be just before the Ffuncall?
635 Neither Fget nor Fput can GC. */
619 /* GCPRO_STACK; */ 636 /* GCPRO_STACK; */
620 DISCARD (n); 637 DISCARD (n);
621 #ifdef BYTE_CODE_METER 638 #ifdef BYTE_CODE_METER
622 if (byte_metering_on && SYMBOLP (TOP)) 639 if (byte_metering_on && SYMBOLP (TOP))
623 { 640 {
743 case Bconstant2: 760 case Bconstant2:
744 PUSH (constants_data[READ_UINT_2]); 761 PUSH (constants_data[READ_UINT_2]);
745 break; 762 break;
746 763
747 case Bcar: 764 case Bcar:
765 /* Fcar can GC via wrong_type_argument. */
766 /* GCPRO_STACK; */
748 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP); 767 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP);
749 break; 768 break;
750 769
751 case Bcdr: 770 case Bcdr:
771 /* Fcdr can GC via wrong_type_argument. */
772 /* GCPRO_STACK; */
752 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP); 773 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP);
753 break; 774 break;
754 775
755 776
756 case Bunbind_all: 777 case Bunbind_all:
760 break; 781 break;
761 782
762 case Bnth: 783 case Bnth:
763 { 784 {
764 Lisp_Object arg = POP; 785 Lisp_Object arg = POP;
786 /* Fcar and Fnthcdr can GC via wrong_type_argument. */
787 /* GCPRO_STACK; */
765 TOP = Fcar (Fnthcdr (TOP, arg)); 788 TOP = Fcar (Fnthcdr (TOP, arg));
766 break; 789 break;
767 } 790 }
768 791
769 case Bsymbolp: 792 case Bsymbolp:
846 case BconcatN: 869 case BconcatN:
847 /* common case */ 870 /* common case */
848 n = READ_UINT_1; 871 n = READ_UINT_1;
849 do_concat: 872 do_concat:
850 DISCARD (n - 1); 873 DISCARD (n - 1);
874 /* Apparently `concat' can GC; Fconcat GCPROs its arguments. */
875 /* GCPRO_STACK; */
851 TOP = Fconcat (n, &TOP); 876 TOP = Fconcat (n, &TOP);
852 break; 877 break;
853 878
854 879
855 case Blength: 880 case Blength:
863 TOP = Faset (TOP, arg1, arg2); 888 TOP = Faset (TOP, arg1, arg2);
864 break; 889 break;
865 } 890 }
866 891
867 case Bsymbol_value: 892 case Bsymbol_value:
893 /* Why does this need GCPRO_STACK? If not, remove others, too. */
868 /* GCPRO_STACK; */ 894 /* GCPRO_STACK; */
869 TOP = Fsymbol_value (TOP); 895 TOP = Fsymbol_value (TOP);
870 break; 896 break;
871 897
872 case Bsymbol_function: 898 case Bsymbol_function:
929 TOP = bytecode_negate (TOP); 955 TOP = bytecode_negate (TOP);
930 break; 956 break;
931 957
932 case Bnconc: 958 case Bnconc:
933 DISCARD (1); 959 DISCARD (1);
960 /* nconc2 GCPROs before calling this. */
961 /* GCPRO_STACK; */
934 TOP = bytecode_nconc2 (&TOP); 962 TOP = bytecode_nconc2 (&TOP);
935 break; 963 break;
936 964
937 case Bplus: 965 case Bplus:
938 { 966 {
967 case Bpoint: 995 case Bpoint:
968 PUSH (make_int (BUF_PT (current_buffer))); 996 PUSH (make_int (BUF_PT (current_buffer)));
969 break; 997 break;
970 998
971 case Binsert: 999 case Binsert:
1000 /* Says it can GC. */
1001 /* GCPRO_STACK; */
972 TOP = Finsert (1, &TOP); 1002 TOP = Finsert (1, &TOP);
973 break; 1003 break;
974 1004
975 case BinsertN: 1005 case BinsertN:
976 n = READ_UINT_1; 1006 n = READ_UINT_1;
977 DISCARD (n - 1); 1007 DISCARD (n - 1);
1008 /* See Binsert. */
1009 /* GCPRO_STACK; */
978 TOP = Finsert (n, &TOP); 1010 TOP = Finsert (n, &TOP);
979 break; 1011 break;
980 1012
981 case Baref: 1013 case Baref:
982 { 1014 {
1002 } 1034 }
1003 1035
1004 case Bequal: 1036 case Bequal:
1005 { 1037 {
1006 Lisp_Object arg = POP; 1038 Lisp_Object arg = POP;
1039 /* Can QUIT, so can GC, right? */
1040 /* GCPRO_STACK; */
1007 TOP = Fequal (TOP, arg); 1041 TOP = Fequal (TOP, arg);
1008 break; 1042 break;
1009 } 1043 }
1010 1044
1011 case Bnthcdr: 1045 case Bnthcdr:
1023 } 1057 }
1024 1058
1025 case Bmember: 1059 case Bmember:
1026 { 1060 {
1027 Lisp_Object arg = POP; 1061 Lisp_Object arg = POP;
1062 /* Can QUIT, so can GC, right? */
1063 /* GCPRO_STACK; */
1028 TOP = Fmember (TOP, arg); 1064 TOP = Fmember (TOP, arg);
1029 break; 1065 break;
1030 } 1066 }
1031 1067
1032 case Bgoto_char: 1068 case Bgoto_char:
1057 break; 1093 break;
1058 1094
1059 case Bskip_chars_forward: 1095 case Bskip_chars_forward:
1060 { 1096 {
1061 Lisp_Object arg = POP; 1097 Lisp_Object arg = POP;
1098 /* Can QUIT, so can GC, right? */
1099 /* GCPRO_STACK; */
1062 TOP = Fskip_chars_forward (TOP, arg, Qnil); 1100 TOP = Fskip_chars_forward (TOP, arg, Qnil);
1063 break; 1101 break;
1064 } 1102 }
1065 1103
1066 case Bassq: 1104 case Bassq: