Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 1884:3d25fd3d9ac4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-01-27 13:23:50 by stephent] GCPRO_STACK whole loop <87ektlo7a9.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Tue, 27 Jan 2004 13:23:53 +0000
parents 90502933fb98
children c66036f59678
comparison
equal deleted inserted replaced
1883:c347bc6e2cb3 1884:3d25fd3d9ac4
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 #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg)
451
450 /* The actual interpreter for byte code. 452 /* The actual interpreter for byte code.
451 This function has been seriously optimized for performance. 453 This function has been seriously optimized for performance.
452 Don't change the constructs unless you are willing to do 454 Don't change the constructs unless you are willing to do
453 real benchmarking and profiling work -- martin */ 455 real benchmarking and profiling work -- martin */
454 456
458 int stack_depth, 460 int stack_depth,
459 Lisp_Object *constants_data) 461 Lisp_Object *constants_data)
460 { 462 {
461 /* This function can GC */ 463 /* This function can GC */
462 REGISTER const Opbyte *program_ptr = (Opbyte *) program; 464 REGISTER const Opbyte *program_ptr = (Opbyte *) program;
463 REGISTER Lisp_Object *stack_ptr 465 Lisp_Object *stack_beg = alloca_array (Lisp_Object, stack_depth + 1);
464 = alloca_array (Lisp_Object, stack_depth + 1); 466 REGISTER Lisp_Object *stack_ptr = stack_beg;
465 int speccount = specpdl_depth (); 467 int speccount = specpdl_depth ();
466 struct gcpro gcpro1; 468 struct gcpro gcpro1;
467 469
468 #ifdef BYTE_CODE_METER 470 #ifdef BYTE_CODE_METER
469 Opcode this_opcode = 0; 471 Opcode this_opcode = 0;
470 Opcode prev_opcode; 472 Opcode prev_opcode;
471 #endif 473 #endif
472 474
473 #ifdef ERROR_CHECK_BYTE_CODE 475 #ifdef ERROR_CHECK_BYTE_CODE
474 Lisp_Object *stack_beg = stack_ptr;
475 Lisp_Object *stack_end = stack_beg + stack_depth; 476 Lisp_Object *stack_end = stack_beg + stack_depth;
476 #endif 477 #endif
477 478
479 #if STATIC_GCPRO_STACK
478 /* Initialize all the objects on the stack to Qnil, 480 /* Initialize all the objects on the stack to Qnil,
479 so we can GCPRO the whole stack. 481 so we can GCPRO the whole stack.
480 The first element of the stack is actually a dummy. */ 482 The first element of the stack is actually a dummy. */
481 { 483 {
482 int i; 484 int i;
483 Lisp_Object *p; 485 Lisp_Object *p;
484 for (i = stack_depth, p = stack_ptr; i--;) 486 for (i = stack_depth, p = stack_ptr; i--;)
485 *++p = Qnil; 487 *++p = Qnil;
486 } 488 }
487 489 #endif
488 GCPRO1 (stack_ptr[1]); 490 GCPRO1 (stack_ptr[1]);
491 #if STATIC_GCPRO_STACK
489 gcpro1.nvars = stack_depth; 492 gcpro1.nvars = stack_depth;
493 #endif
490 494
491 while (1) 495 while (1)
492 { 496 {
493 REGISTER Opcode opcode = (Opcode) READ_UINT_1; 497 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
494 #ifdef ERROR_CHECK_BYTE_CODE 498 #ifdef ERROR_CHECK_BYTE_CODE
502 prev_opcode = this_opcode; 506 prev_opcode = this_opcode;
503 this_opcode = opcode; 507 this_opcode = opcode;
504 meter_code (prev_opcode, this_opcode); 508 meter_code (prev_opcode, this_opcode);
505 #endif 509 #endif
506 510
511 #if !STATIC_GCPRO_STACK
512 GCPRO_STACK;
513 #endif
507 switch (opcode) 514 switch (opcode)
508 { 515 {
509 REGISTER int n; 516 REGISTER int n;
510 517
511 default: 518 default:
512 if (opcode >= Bconstant) 519 if (opcode >= Bconstant)
513 PUSH (constants_data[opcode - Bconstant]); 520 PUSH (constants_data[opcode - Bconstant]);
514 else 521 else
515 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode); 522 {
523 /* We're not sure what these do, so better safe than sorry. */
524 /* GCPRO_STACK; */
525 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
526 }
516 break; 527 break;
517 528
518 case Bvarref: 529 case Bvarref:
519 case Bvarref+1: 530 case Bvarref+1:
520 case Bvarref+2: 531 case Bvarref+2:
547 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); 558 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
548 Lisp_Object old_value = symbol_ptr->value; 559 Lisp_Object old_value = symbol_ptr->value;
549 Lisp_Object new_value = POP; 560 Lisp_Object new_value = POP;
550 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value)) 561 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
551 symbol_ptr->value = new_value; 562 symbol_ptr->value = new_value;
552 else 563 else {
564 /* Fset may call magic handlers */
565 /* GCPRO_STACK; */
553 Fset (symbol, new_value); 566 Fset (symbol, new_value);
567 }
568
554 break; 569 break;
555 } 570 }
556 571
557 case Bvarbind: 572 case Bvarbind:
558 case Bvarbind+1: 573 case Bvarbind+1:
581 #ifdef ERROR_CHECK_CATCH 596 #ifdef ERROR_CHECK_CATCH
582 check_specbind_stack_sanity (); 597 check_specbind_stack_sanity ();
583 #endif 598 #endif
584 } 599 }
585 else 600 else
586 specbind_magic (symbol, new_value); 601 {
602 /* does an Fset, may call magic handlers */
603 /* GCPRO_STACK; */
604 specbind_magic (symbol, new_value);
605 }
587 break; 606 break;
588 } 607 }
589 608
590 case Bcall: 609 case Bcall:
591 case Bcall+1: 610 case Bcall+1:
595 case Bcall+5: 614 case Bcall+5:
596 case Bcall+6: 615 case Bcall+6:
597 case Bcall+7: 616 case Bcall+7:
598 n = (opcode < Bcall+6 ? opcode - Bcall : 617 n = (opcode < Bcall+6 ? opcode - Bcall :
599 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2); 618 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
619 /* GCPRO_STACK; */
600 DISCARD (n); 620 DISCARD (n);
601 #ifdef BYTE_CODE_METER 621 #ifdef BYTE_CODE_METER
602 if (byte_metering_on && SYMBOLP (TOP)) 622 if (byte_metering_on && SYMBOLP (TOP))
603 { 623 {
604 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil); 624 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);
843 TOP = Faset (TOP, arg1, arg2); 863 TOP = Faset (TOP, arg1, arg2);
844 break; 864 break;
845 } 865 }
846 866
847 case Bsymbol_value: 867 case Bsymbol_value:
868 /* GCPRO_STACK; */
848 TOP = Fsymbol_value (TOP); 869 TOP = Fsymbol_value (TOP);
849 break; 870 break;
850 871
851 case Bsymbol_function: 872 case Bsymbol_function:
852 TOP = Fsymbol_function (TOP); 873 TOP = Fsymbol_function (TOP);
972 } 993 }
973 994
974 case Bset: 995 case Bset:
975 { 996 {
976 Lisp_Object arg = POP; 997 Lisp_Object arg = POP;
998 /* Fset may call magic handlers */
999 /* GCPRO_STACK; */
977 TOP = Fset (TOP, arg); 1000 TOP = Fset (TOP, arg);
978 break; 1001 break;
979 } 1002 }
980 1003
981 case Bequal: 1004 case Bequal:
1017 PUSH (buffer); 1040 PUSH (buffer);
1018 break; 1041 break;
1019 } 1042 }
1020 1043
1021 case Bset_buffer: 1044 case Bset_buffer:
1045 /* #### WAG: set-buffer may cause Fset's of buffer locals
1046 Didn't prevent crash. :-( */
1047 /* GCPRO_STACK; */
1022 TOP = Fset_buffer (TOP); 1048 TOP = Fset_buffer (TOP);
1023 break; 1049 break;
1024 1050
1025 case Bpoint_max: 1051 case Bpoint_max:
1026 PUSH (make_int (BUF_ZV (current_buffer))); 1052 PUSH (make_int (BUF_ZV (current_buffer)));