1/* Execution of byte code produced by bytecomp.el. 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003, 2004, 3 2005, 2006, 2007 Free Software Foundation, Inc. 4 5This file is part of GNU Emacs. 6 7GNU Emacs is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Emacs is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Emacs; see the file COPYING. If not, write to 19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 20Boston, MA 02110-1301, USA. 21 22hacked on by jwz@lucid.com 17-jun-91 23 o added a compile-time switch to turn on simple sanity checking; 24 o put back the obsolete byte-codes for error-detection; 25 o added a new instruction, unbind_all, which I will use for 26 tail-recursion elimination; 27 o made temp_output_buffer_show be called with the right number 28 of args; 29 o made the new bytecodes be called with args in the right order; 30 o added metering support. 31 32by Hallvard: 33 o added relative jump instructions; 34 o all conditionals now only do QUIT if they jump. 35 */ 36 37#include <config.h> 38#include "lisp.h" 39#include "buffer.h" 40#include "charset.h" 41#include "syntax.h" 42#include "window.h" 43 44#ifdef CHECK_FRAME_FONT 45#include "frame.h" 46#include "xterm.h" 47#endif 48 49/* 50 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 51 * debugging the byte compiler...) 52 * 53 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 54 */ 55/* #define BYTE_CODE_SAFE */ 56/* #define BYTE_CODE_METER */ 57 58 59#ifdef BYTE_CODE_METER 60 61Lisp_Object Vbyte_code_meter, Qbyte_code_meter; 62int byte_metering_on; 63 64#define METER_2(code1, code2) \ 65 XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ 66 ->contents[(code2)]) 67 68#define METER_1(code) METER_2 (0, (code)) 69 70#define METER_CODE(last_code, this_code) \ 71{ \ 72 if (byte_metering_on) \ 73 { \ 74 if (METER_1 (this_code) < MOST_POSITIVE_FIXNUM) \ 75 METER_1 (this_code)++; \ 76 if (last_code \ 77 && METER_2 (last_code, this_code) < MOST_POSITIVE_FIXNUM) \ 78 METER_2 (last_code, this_code)++; \ 79 } \ 80} 81 82#else /* no BYTE_CODE_METER */ 83 84#define METER_CODE(last_code, this_code) 85 86#endif /* no BYTE_CODE_METER */ 87 88 89Lisp_Object Qbytecode; 90 91/* Byte codes: */ 92 93#define Bvarref 010 94#define Bvarset 020 95#define Bvarbind 030 96#define Bcall 040 97#define Bunbind 050 98 99#define Bnth 070 100#define Bsymbolp 071 101#define Bconsp 072 102#define Bstringp 073 103#define Blistp 074 104#define Beq 075 105#define Bmemq 076 106#define Bnot 077 107#define Bcar 0100 108#define Bcdr 0101 109#define Bcons 0102 110#define Blist1 0103 111#define Blist2 0104 112#define Blist3 0105 113#define Blist4 0106 114#define Blength 0107 115#define Baref 0110 116#define Baset 0111 117#define Bsymbol_value 0112 118#define Bsymbol_function 0113 119#define Bset 0114 120#define Bfset 0115 121#define Bget 0116 122#define Bsubstring 0117 123#define Bconcat2 0120 124#define Bconcat3 0121 125#define Bconcat4 0122 126#define Bsub1 0123 127#define Badd1 0124 128#define Beqlsign 0125 129#define Bgtr 0126 130#define Blss 0127 131#define Bleq 0130 132#define Bgeq 0131 133#define Bdiff 0132 134#define Bnegate 0133 135#define Bplus 0134 136#define Bmax 0135 137#define Bmin 0136 138#define Bmult 0137 139 140#define Bpoint 0140 141/* Was Bmark in v17. */ 142#define Bsave_current_buffer 0141 143#define Bgoto_char 0142 144#define Binsert 0143 145#define Bpoint_max 0144 146#define Bpoint_min 0145 147#define Bchar_after 0146 148#define Bfollowing_char 0147 149#define Bpreceding_char 0150 150#define Bcurrent_column 0151 151#define Bindent_to 0152 152#define Bscan_buffer 0153 /* No longer generated as of v18 */ 153#define Beolp 0154 154#define Beobp 0155 155#define Bbolp 0156 156#define Bbobp 0157 157#define Bcurrent_buffer 0160 158#define Bset_buffer 0161 159#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ 160#define Bread_char 0162 /* No longer generated as of v19 */ 161#define Bset_mark 0163 /* this loser is no longer generated as of v18 */ 162#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ 163 164#define Bforward_char 0165 165#define Bforward_word 0166 166#define Bskip_chars_forward 0167 167#define Bskip_chars_backward 0170 168#define Bforward_line 0171 169#define Bchar_syntax 0172 170#define Bbuffer_substring 0173 171#define Bdelete_region 0174 172#define Bnarrow_to_region 0175 173#define Bwiden 0176 174#define Bend_of_line 0177 175 176#define Bconstant2 0201 177#define Bgoto 0202 178#define Bgotoifnil 0203 179#define Bgotoifnonnil 0204 180#define Bgotoifnilelsepop 0205 181#define Bgotoifnonnilelsepop 0206 182#define Breturn 0207 183#define Bdiscard 0210 184#define Bdup 0211 185 186#define Bsave_excursion 0212 187#define Bsave_window_excursion 0213 188#define Bsave_restriction 0214 189#define Bcatch 0215 190 191#define Bunwind_protect 0216 192#define Bcondition_case 0217 193#define Btemp_output_buffer_setup 0220 194#define Btemp_output_buffer_show 0221 195 196#define Bunbind_all 0222 197 198#define Bset_marker 0223 199#define Bmatch_beginning 0224 200#define Bmatch_end 0225 201#define Bupcase 0226 202#define Bdowncase 0227 203 204#define Bstringeqlsign 0230 205#define Bstringlss 0231 206#define Bequal 0232 207#define Bnthcdr 0233 208#define Belt 0234 209#define Bmember 0235 210#define Bassq 0236 211#define Bnreverse 0237 212#define Bsetcar 0240 213#define Bsetcdr 0241 214#define Bcar_safe 0242 215#define Bcdr_safe 0243 216#define Bnconc 0244 217#define Bquo 0245 218#define Brem 0246 219#define Bnumberp 0247 220#define Bintegerp 0250 221 222#define BRgoto 0252 223#define BRgotoifnil 0253 224#define BRgotoifnonnil 0254 225#define BRgotoifnilelsepop 0255 226#define BRgotoifnonnilelsepop 0256 227 228#define BlistN 0257 229#define BconcatN 0260 230#define BinsertN 0261 231 232#define Bconstant 0300 233#define CONSTANTLIM 0100 234 235 236/* Structure describing a value stack used during byte-code execution 237 in Fbyte_code. */ 238 239struct byte_stack 240{ 241 /* Program counter. This points into the byte_string below 242 and is relocated when that string is relocated. */ 243 const unsigned char *pc; 244 245 /* Top and bottom of stack. The bottom points to an area of memory 246 allocated with alloca in Fbyte_code. */ 247 Lisp_Object *top, *bottom; 248 249 /* The string containing the byte-code, and its current address. 250 Storing this here protects it from GC because mark_byte_stack 251 marks it. */ 252 Lisp_Object byte_string; 253 const unsigned char *byte_string_start; 254 255 /* The vector of constants used during byte-code execution. Storing 256 this here protects it from GC because mark_byte_stack marks it. */ 257 Lisp_Object constants; 258 259 /* Next entry in byte_stack_list. */ 260 struct byte_stack *next; 261}; 262 263/* A list of currently active byte-code execution value stacks. 264 Fbyte_code adds an entry to the head of this list before it starts 265 processing byte-code, and it removed the entry again when it is 266 done. Signalling an error truncates the list analoguous to 267 gcprolist. */ 268 269struct byte_stack *byte_stack_list; 270 271 272/* Mark objects on byte_stack_list. Called during GC. */ 273 274void 275mark_byte_stack () 276{ 277 struct byte_stack *stack; 278 Lisp_Object *obj; 279 280 for (stack = byte_stack_list; stack; stack = stack->next) 281 { 282 /* If STACK->top is null here, this means there's an opcode in 283 Fbyte_code that wasn't expected to GC, but did. To find out 284 which opcode this is, record the value of `stack', and walk 285 up the stack in a debugger, stopping in frames of Fbyte_code. 286 The culprit is found in the frame of Fbyte_code where the 287 address of its local variable `stack' is equal to the 288 recorded value of `stack' here. */ 289 eassert (stack->top); 290 291 for (obj = stack->bottom; obj <= stack->top; ++obj) 292 mark_object (*obj); 293 294 mark_object (stack->byte_string); 295 mark_object (stack->constants); 296 } 297} 298 299 300/* Unmark objects in the stacks on byte_stack_list. Relocate program 301 counters. Called when GC has completed. */ 302 303void 304unmark_byte_stack () 305{ 306 struct byte_stack *stack; 307 308 for (stack = byte_stack_list; stack; stack = stack->next) 309 { 310 if (stack->byte_string_start != SDATA (stack->byte_string)) 311 { 312 int offset = stack->pc - stack->byte_string_start; 313 stack->byte_string_start = SDATA (stack->byte_string); 314 stack->pc = stack->byte_string_start + offset; 315 } 316 } 317} 318 319 320/* Fetch the next byte from the bytecode stream */ 321 322#define FETCH *stack.pc++ 323 324/* Fetch two bytes from the bytecode stream and make a 16-bit number 325 out of them */ 326 327#define FETCH2 (op = FETCH, op + (FETCH << 8)) 328 329/* Push x onto the execution stack. This used to be #define PUSH(x) 330 (*++stackp = (x)) This oddity is necessary because Alliant can't be 331 bothered to compile the preincrement operator properly, as of 4/91. 332 -JimB */ 333 334#define PUSH(x) (top++, *top = (x)) 335 336/* Pop a value off the execution stack. */ 337 338#define POP (*top--) 339 340/* Discard n values from the execution stack. */ 341 342#define DISCARD(n) (top -= (n)) 343 344/* Get the value which is at the top of the execution stack, but don't 345 pop it. */ 346 347#define TOP (*top) 348 349/* Actions that must be performed before and after calling a function 350 that might GC. */ 351 352#define BEFORE_POTENTIAL_GC() stack.top = top 353#define AFTER_POTENTIAL_GC() stack.top = NULL 354 355/* Garbage collect if we have consed enough since the last time. 356 We do this at every branch, to avoid loops that never GC. */ 357 358#define MAYBE_GC() \ 359 if (consing_since_gc > gc_cons_threshold \ 360 && consing_since_gc > gc_relative_threshold) \ 361 { \ 362 BEFORE_POTENTIAL_GC (); \ 363 Fgarbage_collect (); \ 364 AFTER_POTENTIAL_GC (); \ 365 } \ 366 else 367 368/* Check for jumping out of range. */ 369 370#ifdef BYTE_CODE_SAFE 371 372#define CHECK_RANGE(ARG) \ 373 if (ARG >= bytestr_length) abort () 374 375#else /* not BYTE_CODE_SAFE */ 376 377#define CHECK_RANGE(ARG) 378 379#endif /* not BYTE_CODE_SAFE */ 380 381/* A version of the QUIT macro which makes sure that the stack top is 382 set before signaling `quit'. */ 383 384#define BYTE_CODE_QUIT \ 385 do { \ 386 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ 387 { \ 388 Lisp_Object flag = Vquit_flag; \ 389 Vquit_flag = Qnil; \ 390 BEFORE_POTENTIAL_GC (); \ 391 if (EQ (Vthrow_on_input, flag)) \ 392 Fthrow (Vthrow_on_input, Qt); \ 393 Fsignal (Qquit, Qnil); \ 394 AFTER_POTENTIAL_GC (); \ 395 } \ 396 } while (0) 397 398 399DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 400 doc: /* Function used internally in byte-compiled code. 401The first argument, BYTESTR, is a string of byte code; 402the second, VECTOR, a vector of constants; 403the third, MAXDEPTH, the maximum stack depth used in this function. 404If the third argument is incorrect, Emacs may crash. */) 405 (bytestr, vector, maxdepth) 406 Lisp_Object bytestr, vector, maxdepth; 407{ 408 int count = SPECPDL_INDEX (); 409#ifdef BYTE_CODE_METER 410 int this_op = 0; 411 int prev_op; 412#endif 413 int op; 414 /* Lisp_Object v1, v2; */ 415 Lisp_Object *vectorp; 416#ifdef BYTE_CODE_SAFE 417 int const_length = XVECTOR (vector)->size; 418 Lisp_Object *stacke; 419#endif 420 int bytestr_length; 421 struct byte_stack stack; 422 Lisp_Object *top; 423 Lisp_Object result; 424 425#ifdef CHECK_FRAME_FONT 426 { 427 struct frame *f = SELECTED_FRAME (); 428 if (FRAME_X_P (f) 429 && FRAME_FONT (f)->direction != 0 430 && FRAME_FONT (f)->direction != 1) 431 abort (); 432 } 433#endif 434 435 CHECK_STRING (bytestr); 436 CHECK_VECTOR (vector); 437 CHECK_NUMBER (maxdepth); 438 439 if (STRING_MULTIBYTE (bytestr)) 440 /* BYTESTR must have been produced by Emacs 20.2 or the earlier 441 because they produced a raw 8-bit string for byte-code and now 442 such a byte-code string is loaded as multibyte while raw 8-bit 443 characters converted to multibyte form. Thus, now we must 444 convert them back to the originally intended unibyte form. */ 445 bytestr = Fstring_as_unibyte (bytestr); 446 447 bytestr_length = SBYTES (bytestr); 448 vectorp = XVECTOR (vector)->contents; 449 450 stack.byte_string = bytestr; 451 stack.pc = stack.byte_string_start = SDATA (bytestr); 452 stack.constants = vector; 453 stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth) 454 * sizeof (Lisp_Object)); 455 top = stack.bottom - 1; 456 stack.top = NULL; 457 stack.next = byte_stack_list; 458 byte_stack_list = &stack; 459 460#ifdef BYTE_CODE_SAFE 461 stacke = stack.bottom - 1 + XFASTINT (maxdepth); 462#endif 463 464 while (1) 465 { 466#ifdef BYTE_CODE_SAFE 467 if (top > stacke) 468 abort (); 469 else if (top < stack.bottom - 1) 470 abort (); 471#endif 472 473#ifdef BYTE_CODE_METER 474 prev_op = this_op; 475 this_op = op = FETCH; 476 METER_CODE (prev_op, op); 477#else 478 op = FETCH; 479#endif 480 481 switch (op) 482 { 483 case Bvarref + 7: 484 op = FETCH2; 485 goto varref; 486 487 case Bvarref: 488 case Bvarref + 1: 489 case Bvarref + 2: 490 case Bvarref + 3: 491 case Bvarref + 4: 492 case Bvarref + 5: 493 op = op - Bvarref; 494 goto varref; 495 496 /* This seems to be the most frequently executed byte-code 497 among the Bvarref's, so avoid a goto here. */ 498 case Bvarref+6: 499 op = FETCH; 500 varref: 501 { 502 Lisp_Object v1, v2; 503 504 v1 = vectorp[op]; 505 if (SYMBOLP (v1)) 506 { 507 v2 = SYMBOL_VALUE (v1); 508 if (MISCP (v2) || EQ (v2, Qunbound)) 509 { 510 BEFORE_POTENTIAL_GC (); 511 v2 = Fsymbol_value (v1); 512 AFTER_POTENTIAL_GC (); 513 } 514 } 515 else 516 { 517 BEFORE_POTENTIAL_GC (); 518 v2 = Fsymbol_value (v1); 519 AFTER_POTENTIAL_GC (); 520 } 521 PUSH (v2); 522 break; 523 } 524 525 case Bgotoifnil: 526 { 527 Lisp_Object v1; 528 MAYBE_GC (); 529 op = FETCH2; 530 v1 = POP; 531 if (NILP (v1)) 532 { 533 BYTE_CODE_QUIT; 534 CHECK_RANGE (op); 535 stack.pc = stack.byte_string_start + op; 536 } 537 break; 538 } 539 540 case Bcar: 541 { 542 Lisp_Object v1; 543 v1 = TOP; 544 TOP = CAR (v1); 545 break; 546 } 547 548 case Beq: 549 { 550 Lisp_Object v1; 551 v1 = POP; 552 TOP = EQ (v1, TOP) ? Qt : Qnil; 553 break; 554 } 555 556 case Bmemq: 557 { 558 Lisp_Object v1; 559 BEFORE_POTENTIAL_GC (); 560 v1 = POP; 561 TOP = Fmemq (TOP, v1); 562 AFTER_POTENTIAL_GC (); 563 break; 564 } 565 566 case Bcdr: 567 { 568 Lisp_Object v1; 569 v1 = TOP; 570 TOP = CDR (v1); 571 break; 572 } 573 574 case Bvarset: 575 case Bvarset+1: 576 case Bvarset+2: 577 case Bvarset+3: 578 case Bvarset+4: 579 case Bvarset+5: 580 op -= Bvarset; 581 goto varset; 582 583 case Bvarset+7: 584 op = FETCH2; 585 goto varset; 586 587 case Bvarset+6: 588 op = FETCH; 589 varset: 590 { 591 Lisp_Object sym, val; 592 593 sym = vectorp[op]; 594 val = TOP; 595 596 /* Inline the most common case. */ 597 if (SYMBOLP (sym) 598 && !EQ (val, Qunbound) 599 && !XSYMBOL (sym)->indirect_variable 600 && !SYMBOL_CONSTANT_P (sym) 601 && !MISCP (XSYMBOL (sym)->value)) 602 XSYMBOL (sym)->value = val; 603 else 604 { 605 BEFORE_POTENTIAL_GC (); 606 set_internal (sym, val, current_buffer, 0); 607 AFTER_POTENTIAL_GC (); 608 } 609 } 610 (void) POP; 611 break; 612 613 case Bdup: 614 { 615 Lisp_Object v1; 616 v1 = TOP; 617 PUSH (v1); 618 break; 619 } 620 621 /* ------------------ */ 622 623 case Bvarbind+6: 624 op = FETCH; 625 goto varbind; 626 627 case Bvarbind+7: 628 op = FETCH2; 629 goto varbind; 630 631 case Bvarbind: 632 case Bvarbind+1: 633 case Bvarbind+2: 634 case Bvarbind+3: 635 case Bvarbind+4: 636 case Bvarbind+5: 637 op -= Bvarbind; 638 varbind: 639 /* Specbind can signal and thus GC. */ 640 BEFORE_POTENTIAL_GC (); 641 specbind (vectorp[op], POP); 642 AFTER_POTENTIAL_GC (); 643 break; 644 645 case Bcall+6: 646 op = FETCH; 647 goto docall; 648 649 case Bcall+7: 650 op = FETCH2; 651 goto docall; 652 653 case Bcall: 654 case Bcall+1: 655 case Bcall+2: 656 case Bcall+3: 657 case Bcall+4: 658 case Bcall+5: 659 op -= Bcall; 660 docall: 661 { 662 BEFORE_POTENTIAL_GC (); 663 DISCARD (op); 664#ifdef BYTE_CODE_METER 665 if (byte_metering_on && SYMBOLP (TOP)) 666 { 667 Lisp_Object v1, v2; 668 669 v1 = TOP; 670 v2 = Fget (v1, Qbyte_code_meter); 671 if (INTEGERP (v2) 672 && XINT (v2) < MOST_POSITIVE_FIXNUM) 673 { 674 XSETINT (v2, XINT (v2) + 1); 675 Fput (v1, Qbyte_code_meter, v2); 676 } 677 } 678#endif 679 TOP = Ffuncall (op + 1, &TOP); 680 AFTER_POTENTIAL_GC (); 681 break; 682 } 683 684 case Bunbind+6: 685 op = FETCH; 686 goto dounbind; 687 688 case Bunbind+7: 689 op = FETCH2; 690 goto dounbind; 691 692 case Bunbind: 693 case Bunbind+1: 694 case Bunbind+2: 695 case Bunbind+3: 696 case Bunbind+4: 697 case Bunbind+5: 698 op -= Bunbind; 699 dounbind: 700 BEFORE_POTENTIAL_GC (); 701 unbind_to (SPECPDL_INDEX () - op, Qnil); 702 AFTER_POTENTIAL_GC (); 703 break; 704 705 case Bunbind_all: 706 /* To unbind back to the beginning of this frame. Not used yet, 707 but will be needed for tail-recursion elimination. */ 708 BEFORE_POTENTIAL_GC (); 709 unbind_to (count, Qnil); 710 AFTER_POTENTIAL_GC (); 711 break; 712 713 case Bgoto: 714 MAYBE_GC (); 715 BYTE_CODE_QUIT; 716 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ 717 CHECK_RANGE (op); 718 stack.pc = stack.byte_string_start + op; 719 break; 720 721 case Bgotoifnonnil: 722 { 723 Lisp_Object v1; 724 MAYBE_GC (); 725 op = FETCH2; 726 v1 = POP; 727 if (!NILP (v1)) 728 { 729 BYTE_CODE_QUIT; 730 CHECK_RANGE (op); 731 stack.pc = stack.byte_string_start + op; 732 } 733 break; 734 } 735 736 case Bgotoifnilelsepop: 737 MAYBE_GC (); 738 op = FETCH2; 739 if (NILP (TOP)) 740 { 741 BYTE_CODE_QUIT; 742 CHECK_RANGE (op); 743 stack.pc = stack.byte_string_start + op; 744 } 745 else DISCARD (1); 746 break; 747 748 case Bgotoifnonnilelsepop: 749 MAYBE_GC (); 750 op = FETCH2; 751 if (!NILP (TOP)) 752 { 753 BYTE_CODE_QUIT; 754 CHECK_RANGE (op); 755 stack.pc = stack.byte_string_start + op; 756 } 757 else DISCARD (1); 758 break; 759 760 case BRgoto: 761 MAYBE_GC (); 762 BYTE_CODE_QUIT; 763 stack.pc += (int) *stack.pc - 127; 764 break; 765 766 case BRgotoifnil: 767 { 768 Lisp_Object v1; 769 MAYBE_GC (); 770 v1 = POP; 771 if (NILP (v1)) 772 { 773 BYTE_CODE_QUIT; 774 stack.pc += (int) *stack.pc - 128; 775 } 776 stack.pc++; 777 break; 778 } 779 780 case BRgotoifnonnil: 781 { 782 Lisp_Object v1; 783 MAYBE_GC (); 784 v1 = POP; 785 if (!NILP (v1)) 786 { 787 BYTE_CODE_QUIT; 788 stack.pc += (int) *stack.pc - 128; 789 } 790 stack.pc++; 791 break; 792 } 793 794 case BRgotoifnilelsepop: 795 MAYBE_GC (); 796 op = *stack.pc++; 797 if (NILP (TOP)) 798 { 799 BYTE_CODE_QUIT; 800 stack.pc += op - 128; 801 } 802 else DISCARD (1); 803 break; 804 805 case BRgotoifnonnilelsepop: 806 MAYBE_GC (); 807 op = *stack.pc++; 808 if (!NILP (TOP)) 809 { 810 BYTE_CODE_QUIT; 811 stack.pc += op - 128; 812 } 813 else DISCARD (1); 814 break; 815 816 case Breturn: 817 result = POP; 818 goto exit; 819 820 case Bdiscard: 821 DISCARD (1); 822 break; 823 824 case Bconstant2: 825 PUSH (vectorp[FETCH2]); 826 break; 827 828 case Bsave_excursion: 829 record_unwind_protect (save_excursion_restore, 830 save_excursion_save ()); 831 break; 832 833 case Bsave_current_buffer: 834 case Bsave_current_buffer_1: 835 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); 836 break; 837 838 case Bsave_window_excursion: 839 BEFORE_POTENTIAL_GC (); 840 TOP = Fsave_window_excursion (TOP); 841 AFTER_POTENTIAL_GC (); 842 break; 843 844 case Bsave_restriction: 845 record_unwind_protect (save_restriction_restore, 846 save_restriction_save ()); 847 break; 848 849 case Bcatch: 850 { 851 Lisp_Object v1; 852 BEFORE_POTENTIAL_GC (); 853 v1 = POP; 854 TOP = internal_catch (TOP, Feval, v1); 855 AFTER_POTENTIAL_GC (); 856 break; 857 } 858 859 case Bunwind_protect: 860 record_unwind_protect (Fprogn, POP); 861 break; 862 863 case Bcondition_case: 864 { 865 Lisp_Object handlers, body; 866 handlers = POP; 867 body = POP; 868 BEFORE_POTENTIAL_GC (); 869 TOP = internal_lisp_condition_case (TOP, body, handlers); 870 AFTER_POTENTIAL_GC (); 871 break; 872 } 873 874 case Btemp_output_buffer_setup: 875 BEFORE_POTENTIAL_GC (); 876 CHECK_STRING (TOP); 877 temp_output_buffer_setup (SDATA (TOP)); 878 AFTER_POTENTIAL_GC (); 879 TOP = Vstandard_output; 880 break; 881 882 case Btemp_output_buffer_show: 883 { 884 Lisp_Object v1; 885 BEFORE_POTENTIAL_GC (); 886 v1 = POP; 887 temp_output_buffer_show (TOP); 888 TOP = v1; 889 /* pop binding of standard-output */ 890 unbind_to (SPECPDL_INDEX () - 1, Qnil); 891 AFTER_POTENTIAL_GC (); 892 break; 893 } 894 895 case Bnth: 896 { 897 Lisp_Object v1, v2; 898 BEFORE_POTENTIAL_GC (); 899 v1 = POP; 900 v2 = TOP; 901 CHECK_NUMBER (v2); 902 AFTER_POTENTIAL_GC (); 903 op = XINT (v2); 904 immediate_quit = 1; 905 while (--op >= 0 && CONSP (v1)) 906 v1 = XCDR (v1); 907 immediate_quit = 0; 908 TOP = CAR (v1); 909 break; 910 } 911 912 case Bsymbolp: 913 TOP = SYMBOLP (TOP) ? Qt : Qnil; 914 break; 915 916 case Bconsp: 917 TOP = CONSP (TOP) ? Qt : Qnil; 918 break; 919 920 case Bstringp: 921 TOP = STRINGP (TOP) ? Qt : Qnil; 922 break; 923 924 case Blistp: 925 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; 926 break; 927 928 case Bnot: 929 TOP = NILP (TOP) ? Qt : Qnil; 930 break; 931 932 case Bcons: 933 { 934 Lisp_Object v1; 935 v1 = POP; 936 TOP = Fcons (TOP, v1); 937 break; 938 } 939 940 case Blist1: 941 TOP = Fcons (TOP, Qnil); 942 break; 943 944 case Blist2: 945 { 946 Lisp_Object v1; 947 v1 = POP; 948 TOP = Fcons (TOP, Fcons (v1, Qnil)); 949 break; 950 } 951 952 case Blist3: 953 DISCARD (2); 954 TOP = Flist (3, &TOP); 955 break; 956 957 case Blist4: 958 DISCARD (3); 959 TOP = Flist (4, &TOP); 960 break; 961 962 case BlistN: 963 op = FETCH; 964 DISCARD (op - 1); 965 TOP = Flist (op, &TOP); 966 break; 967 968 case Blength: 969 BEFORE_POTENTIAL_GC (); 970 TOP = Flength (TOP); 971 AFTER_POTENTIAL_GC (); 972 break; 973 974 case Baref: 975 { 976 Lisp_Object v1; 977 BEFORE_POTENTIAL_GC (); 978 v1 = POP; 979 TOP = Faref (TOP, v1); 980 AFTER_POTENTIAL_GC (); 981 break; 982 } 983 984 case Baset: 985 { 986 Lisp_Object v1, v2; 987 BEFORE_POTENTIAL_GC (); 988 v2 = POP; v1 = POP; 989 TOP = Faset (TOP, v1, v2); 990 AFTER_POTENTIAL_GC (); 991 break; 992 } 993 994 case Bsymbol_value: 995 BEFORE_POTENTIAL_GC (); 996 TOP = Fsymbol_value (TOP); 997 AFTER_POTENTIAL_GC (); 998 break; 999 1000 case Bsymbol_function: 1001 BEFORE_POTENTIAL_GC (); 1002 TOP = Fsymbol_function (TOP); 1003 AFTER_POTENTIAL_GC (); 1004 break; 1005 1006 case Bset: 1007 { 1008 Lisp_Object v1; 1009 BEFORE_POTENTIAL_GC (); 1010 v1 = POP; 1011 TOP = Fset (TOP, v1); 1012 AFTER_POTENTIAL_GC (); 1013 break; 1014 } 1015 1016 case Bfset: 1017 { 1018 Lisp_Object v1; 1019 BEFORE_POTENTIAL_GC (); 1020 v1 = POP; 1021 TOP = Ffset (TOP, v1); 1022 AFTER_POTENTIAL_GC (); 1023 break; 1024 } 1025 1026 case Bget: 1027 { 1028 Lisp_Object v1; 1029 BEFORE_POTENTIAL_GC (); 1030 v1 = POP; 1031 TOP = Fget (TOP, v1); 1032 AFTER_POTENTIAL_GC (); 1033 break; 1034 } 1035 1036 case Bsubstring: 1037 { 1038 Lisp_Object v1, v2; 1039 BEFORE_POTENTIAL_GC (); 1040 v2 = POP; v1 = POP; 1041 TOP = Fsubstring (TOP, v1, v2); 1042 AFTER_POTENTIAL_GC (); 1043 break; 1044 } 1045 1046 case Bconcat2: 1047 BEFORE_POTENTIAL_GC (); 1048 DISCARD (1); 1049 TOP = Fconcat (2, &TOP); 1050 AFTER_POTENTIAL_GC (); 1051 break; 1052 1053 case Bconcat3: 1054 BEFORE_POTENTIAL_GC (); 1055 DISCARD (2); 1056 TOP = Fconcat (3, &TOP); 1057 AFTER_POTENTIAL_GC (); 1058 break; 1059 1060 case Bconcat4: 1061 BEFORE_POTENTIAL_GC (); 1062 DISCARD (3); 1063 TOP = Fconcat (4, &TOP); 1064 AFTER_POTENTIAL_GC (); 1065 break; 1066 1067 case BconcatN: 1068 op = FETCH; 1069 BEFORE_POTENTIAL_GC (); 1070 DISCARD (op - 1); 1071 TOP = Fconcat (op, &TOP); 1072 AFTER_POTENTIAL_GC (); 1073 break; 1074 1075 case Bsub1: 1076 { 1077 Lisp_Object v1; 1078 v1 = TOP; 1079 if (INTEGERP (v1)) 1080 { 1081 XSETINT (v1, XINT (v1) - 1); 1082 TOP = v1; 1083 } 1084 else 1085 { 1086 BEFORE_POTENTIAL_GC (); 1087 TOP = Fsub1 (v1); 1088 AFTER_POTENTIAL_GC (); 1089 } 1090 break; 1091 } 1092 1093 case Badd1: 1094 { 1095 Lisp_Object v1; 1096 v1 = TOP; 1097 if (INTEGERP (v1)) 1098 { 1099 XSETINT (v1, XINT (v1) + 1); 1100 TOP = v1; 1101 } 1102 else 1103 { 1104 BEFORE_POTENTIAL_GC (); 1105 TOP = Fadd1 (v1); 1106 AFTER_POTENTIAL_GC (); 1107 } 1108 break; 1109 } 1110 1111 case Beqlsign: 1112 { 1113 Lisp_Object v1, v2; 1114 BEFORE_POTENTIAL_GC (); 1115 v2 = POP; v1 = TOP; 1116 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1); 1117 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2); 1118 AFTER_POTENTIAL_GC (); 1119 if (FLOATP (v1) || FLOATP (v2)) 1120 { 1121 double f1, f2; 1122 1123 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1)); 1124 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2)); 1125 TOP = (f1 == f2 ? Qt : Qnil); 1126 } 1127 else 1128 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); 1129 break; 1130 } 1131 1132 case Bgtr: 1133 { 1134 Lisp_Object v1; 1135 BEFORE_POTENTIAL_GC (); 1136 v1 = POP; 1137 TOP = Fgtr (TOP, v1); 1138 AFTER_POTENTIAL_GC (); 1139 break; 1140 } 1141 1142 case Blss: 1143 { 1144 Lisp_Object v1; 1145 BEFORE_POTENTIAL_GC (); 1146 v1 = POP; 1147 TOP = Flss (TOP, v1); 1148 AFTER_POTENTIAL_GC (); 1149 break; 1150 } 1151 1152 case Bleq: 1153 { 1154 Lisp_Object v1; 1155 BEFORE_POTENTIAL_GC (); 1156 v1 = POP; 1157 TOP = Fleq (TOP, v1); 1158 AFTER_POTENTIAL_GC (); 1159 break; 1160 } 1161 1162 case Bgeq: 1163 { 1164 Lisp_Object v1; 1165 BEFORE_POTENTIAL_GC (); 1166 v1 = POP; 1167 TOP = Fgeq (TOP, v1); 1168 AFTER_POTENTIAL_GC (); 1169 break; 1170 } 1171 1172 case Bdiff: 1173 BEFORE_POTENTIAL_GC (); 1174 DISCARD (1); 1175 TOP = Fminus (2, &TOP); 1176 AFTER_POTENTIAL_GC (); 1177 break; 1178 1179 case Bnegate: 1180 { 1181 Lisp_Object v1; 1182 v1 = TOP; 1183 if (INTEGERP (v1)) 1184 { 1185 XSETINT (v1, - XINT (v1)); 1186 TOP = v1; 1187 } 1188 else 1189 { 1190 BEFORE_POTENTIAL_GC (); 1191 TOP = Fminus (1, &TOP); 1192 AFTER_POTENTIAL_GC (); 1193 } 1194 break; 1195 } 1196 1197 case Bplus: 1198 BEFORE_POTENTIAL_GC (); 1199 DISCARD (1); 1200 TOP = Fplus (2, &TOP); 1201 AFTER_POTENTIAL_GC (); 1202 break; 1203 1204 case Bmax: 1205 BEFORE_POTENTIAL_GC (); 1206 DISCARD (1); 1207 TOP = Fmax (2, &TOP); 1208 AFTER_POTENTIAL_GC (); 1209 break; 1210 1211 case Bmin: 1212 BEFORE_POTENTIAL_GC (); 1213 DISCARD (1); 1214 TOP = Fmin (2, &TOP); 1215 AFTER_POTENTIAL_GC (); 1216 break; 1217 1218 case Bmult: 1219 BEFORE_POTENTIAL_GC (); 1220 DISCARD (1); 1221 TOP = Ftimes (2, &TOP); 1222 AFTER_POTENTIAL_GC (); 1223 break; 1224 1225 case Bquo: 1226 BEFORE_POTENTIAL_GC (); 1227 DISCARD (1); 1228 TOP = Fquo (2, &TOP); 1229 AFTER_POTENTIAL_GC (); 1230 break; 1231 1232 case Brem: 1233 { 1234 Lisp_Object v1; 1235 BEFORE_POTENTIAL_GC (); 1236 v1 = POP; 1237 TOP = Frem (TOP, v1); 1238 AFTER_POTENTIAL_GC (); 1239 break; 1240 } 1241 1242 case Bpoint: 1243 { 1244 Lisp_Object v1; 1245 XSETFASTINT (v1, PT); 1246 PUSH (v1); 1247 break; 1248 } 1249 1250 case Bgoto_char: 1251 BEFORE_POTENTIAL_GC (); 1252 TOP = Fgoto_char (TOP); 1253 AFTER_POTENTIAL_GC (); 1254 break; 1255 1256 case Binsert: 1257 BEFORE_POTENTIAL_GC (); 1258 TOP = Finsert (1, &TOP); 1259 AFTER_POTENTIAL_GC (); 1260 break; 1261 1262 case BinsertN: 1263 op = FETCH; 1264 BEFORE_POTENTIAL_GC (); 1265 DISCARD (op - 1); 1266 TOP = Finsert (op, &TOP); 1267 AFTER_POTENTIAL_GC (); 1268 break; 1269 1270 case Bpoint_max: 1271 { 1272 Lisp_Object v1; 1273 XSETFASTINT (v1, ZV); 1274 PUSH (v1); 1275 break; 1276 } 1277 1278 case Bpoint_min: 1279 { 1280 Lisp_Object v1; 1281 XSETFASTINT (v1, BEGV); 1282 PUSH (v1); 1283 break; 1284 } 1285 1286 case Bchar_after: 1287 BEFORE_POTENTIAL_GC (); 1288 TOP = Fchar_after (TOP); 1289 AFTER_POTENTIAL_GC (); 1290 break; 1291 1292 case Bfollowing_char: 1293 { 1294 Lisp_Object v1; 1295 BEFORE_POTENTIAL_GC (); 1296 v1 = Ffollowing_char (); 1297 AFTER_POTENTIAL_GC (); 1298 PUSH (v1); 1299 break; 1300 } 1301 1302 case Bpreceding_char: 1303 { 1304 Lisp_Object v1; 1305 BEFORE_POTENTIAL_GC (); 1306 v1 = Fprevious_char (); 1307 AFTER_POTENTIAL_GC (); 1308 PUSH (v1); 1309 break; 1310 } 1311 1312 case Bcurrent_column: 1313 { 1314 Lisp_Object v1; 1315 BEFORE_POTENTIAL_GC (); 1316 XSETFASTINT (v1, (int) current_column ()); /* iftc */ 1317 AFTER_POTENTIAL_GC (); 1318 PUSH (v1); 1319 break; 1320 } 1321 1322 case Bindent_to: 1323 BEFORE_POTENTIAL_GC (); 1324 TOP = Findent_to (TOP, Qnil); 1325 AFTER_POTENTIAL_GC (); 1326 break; 1327 1328 case Beolp: 1329 PUSH (Feolp ()); 1330 break; 1331 1332 case Beobp: 1333 PUSH (Feobp ()); 1334 break; 1335 1336 case Bbolp: 1337 PUSH (Fbolp ()); 1338 break; 1339 1340 case Bbobp: 1341 PUSH (Fbobp ()); 1342 break; 1343 1344 case Bcurrent_buffer: 1345 PUSH (Fcurrent_buffer ()); 1346 break; 1347 1348 case Bset_buffer: 1349 BEFORE_POTENTIAL_GC (); 1350 TOP = Fset_buffer (TOP); 1351 AFTER_POTENTIAL_GC (); 1352 break; 1353 1354 case Binteractive_p: 1355 PUSH (Finteractive_p ()); 1356 break; 1357 1358 case Bforward_char: 1359 BEFORE_POTENTIAL_GC (); 1360 TOP = Fforward_char (TOP); 1361 AFTER_POTENTIAL_GC (); 1362 break; 1363 1364 case Bforward_word: 1365 BEFORE_POTENTIAL_GC (); 1366 TOP = Fforward_word (TOP); 1367 AFTER_POTENTIAL_GC (); 1368 break; 1369 1370 case Bskip_chars_forward: 1371 { 1372 Lisp_Object v1; 1373 BEFORE_POTENTIAL_GC (); 1374 v1 = POP; 1375 TOP = Fskip_chars_forward (TOP, v1); 1376 AFTER_POTENTIAL_GC (); 1377 break; 1378 } 1379 1380 case Bskip_chars_backward: 1381 { 1382 Lisp_Object v1; 1383 BEFORE_POTENTIAL_GC (); 1384 v1 = POP; 1385 TOP = Fskip_chars_backward (TOP, v1); 1386 AFTER_POTENTIAL_GC (); 1387 break; 1388 } 1389 1390 case Bforward_line: 1391 BEFORE_POTENTIAL_GC (); 1392 TOP = Fforward_line (TOP); 1393 AFTER_POTENTIAL_GC (); 1394 break; 1395 1396 case Bchar_syntax: 1397 BEFORE_POTENTIAL_GC (); 1398 CHECK_NUMBER (TOP); 1399 AFTER_POTENTIAL_GC (); 1400 XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]); 1401 break; 1402 1403 case Bbuffer_substring: 1404 { 1405 Lisp_Object v1; 1406 BEFORE_POTENTIAL_GC (); 1407 v1 = POP; 1408 TOP = Fbuffer_substring (TOP, v1); 1409 AFTER_POTENTIAL_GC (); 1410 break; 1411 } 1412 1413 case Bdelete_region: 1414 { 1415 Lisp_Object v1; 1416 BEFORE_POTENTIAL_GC (); 1417 v1 = POP; 1418 TOP = Fdelete_region (TOP, v1); 1419 AFTER_POTENTIAL_GC (); 1420 break; 1421 } 1422 1423 case Bnarrow_to_region: 1424 { 1425 Lisp_Object v1; 1426 BEFORE_POTENTIAL_GC (); 1427 v1 = POP; 1428 TOP = Fnarrow_to_region (TOP, v1); 1429 AFTER_POTENTIAL_GC (); 1430 break; 1431 } 1432 1433 case Bwiden: 1434 BEFORE_POTENTIAL_GC (); 1435 PUSH (Fwiden ()); 1436 AFTER_POTENTIAL_GC (); 1437 break; 1438 1439 case Bend_of_line: 1440 BEFORE_POTENTIAL_GC (); 1441 TOP = Fend_of_line (TOP); 1442 AFTER_POTENTIAL_GC (); 1443 break; 1444 1445 case Bset_marker: 1446 { 1447 Lisp_Object v1, v2; 1448 BEFORE_POTENTIAL_GC (); 1449 v1 = POP; 1450 v2 = POP; 1451 TOP = Fset_marker (TOP, v2, v1); 1452 AFTER_POTENTIAL_GC (); 1453 break; 1454 } 1455 1456 case Bmatch_beginning: 1457 BEFORE_POTENTIAL_GC (); 1458 TOP = Fmatch_beginning (TOP); 1459 AFTER_POTENTIAL_GC (); 1460 break; 1461 1462 case Bmatch_end: 1463 BEFORE_POTENTIAL_GC (); 1464 TOP = Fmatch_end (TOP); 1465 AFTER_POTENTIAL_GC (); 1466 break; 1467 1468 case Bupcase: 1469 BEFORE_POTENTIAL_GC (); 1470 TOP = Fupcase (TOP); 1471 AFTER_POTENTIAL_GC (); 1472 break; 1473 1474 case Bdowncase: 1475 BEFORE_POTENTIAL_GC (); 1476 TOP = Fdowncase (TOP); 1477 AFTER_POTENTIAL_GC (); 1478 break; 1479 1480 case Bstringeqlsign: 1481 { 1482 Lisp_Object v1; 1483 BEFORE_POTENTIAL_GC (); 1484 v1 = POP; 1485 TOP = Fstring_equal (TOP, v1); 1486 AFTER_POTENTIAL_GC (); 1487 break; 1488 } 1489 1490 case Bstringlss: 1491 { 1492 Lisp_Object v1; 1493 BEFORE_POTENTIAL_GC (); 1494 v1 = POP; 1495 TOP = Fstring_lessp (TOP, v1); 1496 AFTER_POTENTIAL_GC (); 1497 break; 1498 } 1499 1500 case Bequal: 1501 { 1502 Lisp_Object v1; 1503 v1 = POP; 1504 TOP = Fequal (TOP, v1); 1505 break; 1506 } 1507 1508 case Bnthcdr: 1509 { 1510 Lisp_Object v1; 1511 BEFORE_POTENTIAL_GC (); 1512 v1 = POP; 1513 TOP = Fnthcdr (TOP, v1); 1514 AFTER_POTENTIAL_GC (); 1515 break; 1516 } 1517 1518 case Belt: 1519 { 1520 Lisp_Object v1, v2; 1521 if (CONSP (TOP)) 1522 { 1523 /* Exchange args and then do nth. */ 1524 BEFORE_POTENTIAL_GC (); 1525 v2 = POP; 1526 v1 = TOP; 1527 CHECK_NUMBER (v2); 1528 AFTER_POTENTIAL_GC (); 1529 op = XINT (v2); 1530 immediate_quit = 1; 1531 while (--op >= 0 && CONSP (v1)) 1532 v1 = XCDR (v1); 1533 immediate_quit = 0; 1534 TOP = CAR (v1); 1535 } 1536 else 1537 { 1538 BEFORE_POTENTIAL_GC (); 1539 v1 = POP; 1540 TOP = Felt (TOP, v1); 1541 AFTER_POTENTIAL_GC (); 1542 } 1543 break; 1544 } 1545 1546 case Bmember: 1547 { 1548 Lisp_Object v1; 1549 BEFORE_POTENTIAL_GC (); 1550 v1 = POP; 1551 TOP = Fmember (TOP, v1); 1552 AFTER_POTENTIAL_GC (); 1553 break; 1554 } 1555 1556 case Bassq: 1557 { 1558 Lisp_Object v1; 1559 BEFORE_POTENTIAL_GC (); 1560 v1 = POP; 1561 TOP = Fassq (TOP, v1); 1562 AFTER_POTENTIAL_GC (); 1563 break; 1564 } 1565 1566 case Bnreverse: 1567 BEFORE_POTENTIAL_GC (); 1568 TOP = Fnreverse (TOP); 1569 AFTER_POTENTIAL_GC (); 1570 break; 1571 1572 case Bsetcar: 1573 { 1574 Lisp_Object v1; 1575 BEFORE_POTENTIAL_GC (); 1576 v1 = POP; 1577 TOP = Fsetcar (TOP, v1); 1578 AFTER_POTENTIAL_GC (); 1579 break; 1580 } 1581 1582 case Bsetcdr: 1583 { 1584 Lisp_Object v1; 1585 BEFORE_POTENTIAL_GC (); 1586 v1 = POP; 1587 TOP = Fsetcdr (TOP, v1); 1588 AFTER_POTENTIAL_GC (); 1589 break; 1590 } 1591 1592 case Bcar_safe: 1593 { 1594 Lisp_Object v1; 1595 v1 = TOP; 1596 TOP = CAR_SAFE (v1); 1597 break; 1598 } 1599 1600 case Bcdr_safe: 1601 { 1602 Lisp_Object v1; 1603 v1 = TOP; 1604 TOP = CDR_SAFE (v1); 1605 break; 1606 } 1607 1608 case Bnconc: 1609 BEFORE_POTENTIAL_GC (); 1610 DISCARD (1); 1611 TOP = Fnconc (2, &TOP); 1612 AFTER_POTENTIAL_GC (); 1613 break; 1614 1615 case Bnumberp: 1616 TOP = (NUMBERP (TOP) ? Qt : Qnil); 1617 break; 1618 1619 case Bintegerp: 1620 TOP = INTEGERP (TOP) ? Qt : Qnil; 1621 break; 1622 1623#ifdef BYTE_CODE_SAFE 1624 case Bset_mark: 1625 BEFORE_POTENTIAL_GC (); 1626 error ("set-mark is an obsolete bytecode"); 1627 AFTER_POTENTIAL_GC (); 1628 break; 1629 case Bscan_buffer: 1630 BEFORE_POTENTIAL_GC (); 1631 error ("scan-buffer is an obsolete bytecode"); 1632 AFTER_POTENTIAL_GC (); 1633 break; 1634#endif 1635 1636 case 0: 1637 abort (); 1638 1639 case 255: 1640 default: 1641#ifdef BYTE_CODE_SAFE 1642 if (op < Bconstant) 1643 { 1644 abort (); 1645 } 1646 if ((op -= Bconstant) >= const_length) 1647 { 1648 abort (); 1649 } 1650 PUSH (vectorp[op]); 1651#else 1652 PUSH (vectorp[op - Bconstant]); 1653#endif 1654 } 1655 } 1656 1657 exit: 1658 1659 byte_stack_list = byte_stack_list->next; 1660 1661 /* Binds and unbinds are supposed to be compiled balanced. */ 1662 if (SPECPDL_INDEX () != count) 1663#ifdef BYTE_CODE_SAFE 1664 error ("binding stack not balanced (serious byte compiler bug)"); 1665#else 1666 abort (); 1667#endif 1668 1669 return result; 1670} 1671 1672void 1673syms_of_bytecode () 1674{ 1675 Qbytecode = intern ("byte-code"); 1676 staticpro (&Qbytecode); 1677 1678 defsubr (&Sbyte_code); 1679 1680#ifdef BYTE_CODE_METER 1681 1682 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, 1683 doc: /* A vector of vectors which holds a histogram of byte-code usage. 1684\(aref (aref byte-code-meter 0) CODE) indicates how many times the byte 1685opcode CODE has been executed. 1686\(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0, 1687indicates how many times the byte opcodes CODE1 and CODE2 have been 1688executed in succession. */); 1689 1690 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, 1691 doc: /* If non-nil, keep profiling information on byte code usage. 1692The variable byte-code-meter indicates how often each byte opcode is used. 1693If a symbol has a property named `byte-code-meter' whose value is an 1694integer, it is incremented each time that symbol's function is called. */); 1695 1696 byte_metering_on = 0; 1697 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); 1698 Qbyte_code_meter = intern ("byte-code-meter"); 1699 staticpro (&Qbyte_code_meter); 1700 { 1701 int i = 256; 1702 while (i--) 1703 XVECTOR (Vbyte_code_meter)->contents[i] = 1704 Fmake_vector (make_number (256), make_number (0)); 1705 } 1706#endif 1707} 1708 1709/* arch-tag: b9803b6f-1ed6-4190-8adf-33fd3a9d10e9 1710 (do not change this comment) */ 1711