comparison src/bytecode.c @ 1758:90502933fb98

[xemacs-hg @ 2003-10-21 08:21:00 by stephent] revert "fix space leak" patch <87oewb0zqn.fsf_-_@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Tue, 21 Oct 2003 08:21:08 +0000
parents 68ed93de81b7
children 3d25fd3d9ac4
comparison
equal deleted inserted replaced
1757:d7a328610d7d 1758:90502933fb98
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
452 /* The actual interpreter for byte code. 450 /* The actual interpreter for byte code.
453 This function has been seriously optimized for performance. 451 This function has been seriously optimized for performance.
454 Don't change the constructs unless you are willing to do 452 Don't change the constructs unless you are willing to do
455 real benchmarking and profiling work -- martin */ 453 real benchmarking and profiling work -- martin */
456 454
460 int stack_depth, 458 int stack_depth,
461 Lisp_Object *constants_data) 459 Lisp_Object *constants_data)
462 { 460 {
463 /* This function can GC */ 461 /* This function can GC */
464 REGISTER const Opbyte *program_ptr = (Opbyte *) program; 462 REGISTER const Opbyte *program_ptr = (Opbyte *) program;
465 Lisp_Object *stack_beg = alloca_array (Lisp_Object, stack_depth + 1); 463 REGISTER Lisp_Object *stack_ptr
466 REGISTER Lisp_Object *stack_ptr = stack_beg; 464 = alloca_array (Lisp_Object, stack_depth + 1);
467 int speccount = specpdl_depth (); 465 int speccount = specpdl_depth ();
468 struct gcpro gcpro1; 466 struct gcpro gcpro1;
469 467
470 #ifdef BYTE_CODE_METER 468 #ifdef BYTE_CODE_METER
471 Opcode this_opcode = 0; 469 Opcode this_opcode = 0;
472 Opcode prev_opcode; 470 Opcode prev_opcode;
473 #endif 471 #endif
474 472
475 #ifdef ERROR_CHECK_BYTE_CODE 473 #ifdef ERROR_CHECK_BYTE_CODE
474 Lisp_Object *stack_beg = stack_ptr;
476 Lisp_Object *stack_end = stack_beg + stack_depth; 475 Lisp_Object *stack_end = stack_beg + stack_depth;
477 #endif 476 #endif
478 477
478 /* Initialize all the objects on the stack to Qnil,
479 so we can GCPRO the whole stack.
480 The first element of the stack is actually a dummy. */
481 {
482 int i;
483 Lisp_Object *p;
484 for (i = stack_depth, p = stack_ptr; i--;)
485 *++p = Qnil;
486 }
487
479 GCPRO1 (stack_ptr[1]); 488 GCPRO1 (stack_ptr[1]);
480 489 gcpro1.nvars = stack_depth;
490
481 while (1) 491 while (1)
482 { 492 {
483 REGISTER Opcode opcode = (Opcode) READ_UINT_1; 493 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
484 #ifdef ERROR_CHECK_BYTE_CODE 494 #ifdef ERROR_CHECK_BYTE_CODE
485 if (stack_ptr > stack_end) 495 if (stack_ptr > stack_end)
500 510
501 default: 511 default:
502 if (opcode >= Bconstant) 512 if (opcode >= Bconstant)
503 PUSH (constants_data[opcode - Bconstant]); 513 PUSH (constants_data[opcode - Bconstant]);
504 else 514 else
505 { 515 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
506 GCPRO_STACK;
507 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
508 }
509 break; 516 break;
510 517
511 case Bvarref: 518 case Bvarref:
512 case Bvarref+1: 519 case Bvarref+1:
513 case Bvarref+2: 520 case Bvarref+2:
588 case Bcall+5: 595 case Bcall+5:
589 case Bcall+6: 596 case Bcall+6:
590 case Bcall+7: 597 case Bcall+7:
591 n = (opcode < Bcall+6 ? opcode - Bcall : 598 n = (opcode < Bcall+6 ? opcode - Bcall :
592 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2); 599 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
593 GCPRO_STACK;
594 DISCARD (n); 600 DISCARD (n);
595 #ifdef BYTE_CODE_METER 601 #ifdef BYTE_CODE_METER
596 if (byte_metering_on && SYMBOLP (TOP)) 602 if (byte_metering_on && SYMBOLP (TOP))
597 { 603 {
598 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil); 604 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);