Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 1626:5cec7ab01719

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-08-16 14:18:36 by michaels] 2003-08-12 Mike Sperber <mike@xemacs.org> * bytecode.c (GCPRO_STACK): Added. (execute_optimized_program): Use GCPRO_STACK, fixing a space leak: Formerly, the byte-code engine would always hold on to the entire stack memory area, including the stuff above the top. Now, we adjust the GCPRO record via GCPRO_STACK just before a GC may occur.
author michaels
date Sat, 16 Aug 2003 14:18:38 +0000
parents e22b0213b713
children 6c996a26d761
comparison
equal deleted inserted replaced
1625:b7261453102e 1626:5cec7ab01719
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
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
488 GCPRO1 (stack_ptr[1]); 479 GCPRO1 (stack_ptr[1]);
489 gcpro1.nvars = stack_depth; 480
490
491 while (1) 481 while (1)
492 { 482 {
493 REGISTER Opcode opcode = (Opcode) READ_UINT_1; 483 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
494 #ifdef ERROR_CHECK_BYTE_CODE 484 #ifdef ERROR_CHECK_BYTE_CODE
495 if (stack_ptr > stack_end) 485 if (stack_ptr > stack_end)
510 500
511 default: 501 default:
512 if (opcode >= Bconstant) 502 if (opcode >= Bconstant)
513 PUSH (constants_data[opcode - Bconstant]); 503 PUSH (constants_data[opcode - Bconstant]);
514 else 504 else
515 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode); 505 {
506 GCPRO_STACK;
507 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
508 }
516 break; 509 break;
517 510
518 case Bvarref: 511 case Bvarref:
519 case Bvarref+1: 512 case Bvarref+1:
520 case Bvarref+2: 513 case Bvarref+2:
595 case Bcall+5: 588 case Bcall+5:
596 case Bcall+6: 589 case Bcall+6:
597 case Bcall+7: 590 case Bcall+7:
598 n = (opcode < Bcall+6 ? opcode - Bcall : 591 n = (opcode < Bcall+6 ? opcode - Bcall :
599 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2); 592 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
593 GCPRO_STACK;
600 DISCARD (n); 594 DISCARD (n);
601 #ifdef BYTE_CODE_METER 595 #ifdef BYTE_CODE_METER
602 if (byte_metering_on && SYMBOLP (TOP)) 596 if (byte_metering_on && SYMBOLP (TOP))
603 { 597 {
604 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil); 598 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);