Mercurial > hg > xemacs-beta
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); |