Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-40
[bpt/emacs.git] / src / bytecode.c
1 /* Execution of byte code produced by bytecomp.el.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003, 2004
3 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.
21
22 hacked 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
32 by 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 "character.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 \f
59 #ifdef BYTE_CODE_METER
60
61 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
62 int 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 \f
88
89 Lisp_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 \f
236 /* Structure describing a value stack used during byte-code execution
237 in Fbyte_code. */
238
239 struct 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
269 struct byte_stack *byte_stack_list;
270
271 \f
272 /* Mark objects on byte_stack_list. Called during GC. */
273
274 void
275 mark_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
303 void
304 unmark_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 \f
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 { \
361 BEFORE_POTENTIAL_GC (); \
362 Fgarbage_collect (); \
363 AFTER_POTENTIAL_GC (); \
364 } \
365 else
366
367 /* Check for jumping out of range. */
368
369 #ifdef BYTE_CODE_SAFE
370
371 #define CHECK_RANGE(ARG) \
372 if (ARG >= bytestr_length) abort ()
373
374 #else /* not BYTE_CODE_SAFE */
375
376 #define CHECK_RANGE(ARG)
377
378 #endif /* not BYTE_CODE_SAFE */
379
380 /* A version of the QUIT macro which makes sure that the stack top is
381 set before signaling `quit'. */
382
383 #define BYTE_CODE_QUIT \
384 do { \
385 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
386 { \
387 Vquit_flag = Qnil; \
388 BEFORE_POTENTIAL_GC (); \
389 Fsignal (Qquit, Qnil); \
390 AFTER_POTENTIAL_GC (); \
391 } \
392 } while (0)
393
394
395 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
396 doc: /* Function used internally in byte-compiled code.
397 The first argument, BYTESTR, is a string of byte code;
398 the second, VECTOR, a vector of constants;
399 the third, MAXDEPTH, the maximum stack depth used in this function.
400 If the third argument is incorrect, Emacs may crash. */)
401 (bytestr, vector, maxdepth)
402 Lisp_Object bytestr, vector, maxdepth;
403 {
404 int count = SPECPDL_INDEX ();
405 #ifdef BYTE_CODE_METER
406 int this_op = 0;
407 int prev_op;
408 #endif
409 int op;
410 /* Lisp_Object v1, v2; */
411 Lisp_Object *vectorp;
412 #ifdef BYTE_CODE_SAFE
413 int const_length = XVECTOR (vector)->size;
414 Lisp_Object *stacke;
415 #endif
416 int bytestr_length;
417 struct byte_stack stack;
418 Lisp_Object *top;
419 Lisp_Object result;
420
421 #ifdef CHECK_FRAME_FONT
422 {
423 struct frame *f = SELECTED_FRAME ();
424 if (FRAME_X_P (f)
425 && FRAME_FONT (f)->direction != 0
426 && FRAME_FONT (f)->direction != 1)
427 abort ();
428 }
429 #endif
430
431 CHECK_STRING (bytestr);
432 if (!VECTORP (vector))
433 vector = wrong_type_argument (Qvectorp, vector);
434 CHECK_NUMBER (maxdepth);
435
436 if (STRING_MULTIBYTE (bytestr))
437 /* BYTESTR must have been produced by Emacs 20.2 or the earlier
438 because they produced a raw 8-bit string for byte-code and now
439 such a byte-code string is loaded as multibyte while raw 8-bit
440 characters converted to multibyte form. Thus, now we must
441 convert them back to the originally intended unibyte form. */
442 bytestr = Fstring_as_unibyte (bytestr);
443
444 bytestr_length = SBYTES (bytestr);
445 vectorp = XVECTOR (vector)->contents;
446
447 stack.byte_string = bytestr;
448 stack.pc = stack.byte_string_start = SDATA (bytestr);
449 stack.constants = vector;
450 stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth)
451 * sizeof (Lisp_Object));
452 top = stack.bottom - 1;
453 stack.top = NULL;
454 stack.next = byte_stack_list;
455 byte_stack_list = &stack;
456
457 #ifdef BYTE_CODE_SAFE
458 stacke = stack.bottom - 1 + XFASTINT (maxdepth);
459 #endif
460
461 while (1)
462 {
463 #ifdef BYTE_CODE_SAFE
464 if (top > stacke)
465 abort ();
466 else if (top < stack.bottom - 1)
467 abort ();
468 #endif
469
470 #ifdef BYTE_CODE_METER
471 prev_op = this_op;
472 this_op = op = FETCH;
473 METER_CODE (prev_op, op);
474 #else
475 op = FETCH;
476 #endif
477
478 switch (op)
479 {
480 case Bvarref + 7:
481 op = FETCH2;
482 goto varref;
483
484 case Bvarref:
485 case Bvarref + 1:
486 case Bvarref + 2:
487 case Bvarref + 3:
488 case Bvarref + 4:
489 case Bvarref + 5:
490 op = op - Bvarref;
491 goto varref;
492
493 /* This seems to be the most frequently executed byte-code
494 among the Bvarref's, so avoid a goto here. */
495 case Bvarref+6:
496 op = FETCH;
497 varref:
498 {
499 Lisp_Object v1, v2;
500
501 v1 = vectorp[op];
502 if (SYMBOLP (v1))
503 {
504 v2 = SYMBOL_VALUE (v1);
505 if (MISCP (v2) || EQ (v2, Qunbound))
506 {
507 BEFORE_POTENTIAL_GC ();
508 v2 = Fsymbol_value (v1);
509 AFTER_POTENTIAL_GC ();
510 }
511 }
512 else
513 {
514 BEFORE_POTENTIAL_GC ();
515 v2 = Fsymbol_value (v1);
516 AFTER_POTENTIAL_GC ();
517 }
518 PUSH (v2);
519 break;
520 }
521
522 case Bgotoifnil:
523 MAYBE_GC ();
524 op = FETCH2;
525 if (NILP (POP))
526 {
527 BYTE_CODE_QUIT;
528 CHECK_RANGE (op);
529 stack.pc = stack.byte_string_start + op;
530 }
531 break;
532
533 case Bcar:
534 {
535 Lisp_Object v1;
536 v1 = TOP;
537 if (CONSP (v1))
538 TOP = XCAR (v1);
539 else if (NILP (v1))
540 TOP = Qnil;
541 else
542 {
543 wrong_type_argument (Qlistp, v1);
544 }
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 if (CONSP (v1))
571 TOP = XCDR (v1);
572 else if (NILP (v1))
573 TOP = Qnil;
574 else
575 {
576 wrong_type_argument (Qlistp, v1);
577 }
578 break;
579 }
580
581 case Bvarset:
582 case Bvarset+1:
583 case Bvarset+2:
584 case Bvarset+3:
585 case Bvarset+4:
586 case Bvarset+5:
587 op -= Bvarset;
588 goto varset;
589
590 case Bvarset+7:
591 op = FETCH2;
592 goto varset;
593
594 case Bvarset+6:
595 op = FETCH;
596 varset:
597 {
598 Lisp_Object sym, val;
599
600 sym = vectorp[op];
601 val = TOP;
602
603 /* Inline the most common case. */
604 if (SYMBOLP (sym)
605 && !EQ (val, Qunbound)
606 && !XSYMBOL (sym)->indirect_variable
607 && !XSYMBOL (sym)->constant
608 && !MISCP (XSYMBOL (sym)->value))
609 XSYMBOL (sym)->value = val;
610 else
611 {
612 BEFORE_POTENTIAL_GC ();
613 set_internal (sym, val, current_buffer, 0);
614 AFTER_POTENTIAL_GC ();
615 }
616 }
617 (void) POP;
618 break;
619
620 case Bdup:
621 {
622 Lisp_Object v1;
623 v1 = TOP;
624 PUSH (v1);
625 break;
626 }
627
628 /* ------------------ */
629
630 case Bvarbind+6:
631 op = FETCH;
632 goto varbind;
633
634 case Bvarbind+7:
635 op = FETCH2;
636 goto varbind;
637
638 case Bvarbind:
639 case Bvarbind+1:
640 case Bvarbind+2:
641 case Bvarbind+3:
642 case Bvarbind+4:
643 case Bvarbind+5:
644 op -= Bvarbind;
645 varbind:
646 /* Specbind can signal and thus GC. */
647 BEFORE_POTENTIAL_GC ();
648 specbind (vectorp[op], POP);
649 AFTER_POTENTIAL_GC ();
650 break;
651
652 case Bcall+6:
653 op = FETCH;
654 goto docall;
655
656 case Bcall+7:
657 op = FETCH2;
658 goto docall;
659
660 case Bcall:
661 case Bcall+1:
662 case Bcall+2:
663 case Bcall+3:
664 case Bcall+4:
665 case Bcall+5:
666 op -= Bcall;
667 docall:
668 {
669 BEFORE_POTENTIAL_GC ();
670 DISCARD (op);
671 #ifdef BYTE_CODE_METER
672 if (byte_metering_on && SYMBOLP (TOP))
673 {
674 Lisp_Object v1, v2;
675
676 v1 = TOP;
677 v2 = Fget (v1, Qbyte_code_meter);
678 if (INTEGERP (v2)
679 && XINT (v2) < MOST_POSITIVE_FIXNUM)
680 {
681 XSETINT (v2, XINT (v2) + 1);
682 Fput (v1, Qbyte_code_meter, v2);
683 }
684 }
685 #endif
686 TOP = Ffuncall (op + 1, &TOP);
687 AFTER_POTENTIAL_GC ();
688 break;
689 }
690
691 case Bunbind+6:
692 op = FETCH;
693 goto dounbind;
694
695 case Bunbind+7:
696 op = FETCH2;
697 goto dounbind;
698
699 case Bunbind:
700 case Bunbind+1:
701 case Bunbind+2:
702 case Bunbind+3:
703 case Bunbind+4:
704 case Bunbind+5:
705 op -= Bunbind;
706 dounbind:
707 BEFORE_POTENTIAL_GC ();
708 unbind_to (SPECPDL_INDEX () - op, Qnil);
709 AFTER_POTENTIAL_GC ();
710 break;
711
712 case Bunbind_all:
713 /* To unbind back to the beginning of this frame. Not used yet,
714 but will be needed for tail-recursion elimination. */
715 BEFORE_POTENTIAL_GC ();
716 unbind_to (count, Qnil);
717 AFTER_POTENTIAL_GC ();
718 break;
719
720 case Bgoto:
721 MAYBE_GC ();
722 BYTE_CODE_QUIT;
723 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
724 CHECK_RANGE (op);
725 stack.pc = stack.byte_string_start + op;
726 break;
727
728 case Bgotoifnonnil:
729 MAYBE_GC ();
730 op = FETCH2;
731 if (!NILP (POP))
732 {
733 BYTE_CODE_QUIT;
734 CHECK_RANGE (op);
735 stack.pc = stack.byte_string_start + op;
736 }
737 break;
738
739 case Bgotoifnilelsepop:
740 MAYBE_GC ();
741 op = FETCH2;
742 if (NILP (TOP))
743 {
744 BYTE_CODE_QUIT;
745 CHECK_RANGE (op);
746 stack.pc = stack.byte_string_start + op;
747 }
748 else DISCARD (1);
749 break;
750
751 case Bgotoifnonnilelsepop:
752 MAYBE_GC ();
753 op = FETCH2;
754 if (!NILP (TOP))
755 {
756 BYTE_CODE_QUIT;
757 CHECK_RANGE (op);
758 stack.pc = stack.byte_string_start + op;
759 }
760 else DISCARD (1);
761 break;
762
763 case BRgoto:
764 MAYBE_GC ();
765 BYTE_CODE_QUIT;
766 stack.pc += (int) *stack.pc - 127;
767 break;
768
769 case BRgotoifnil:
770 MAYBE_GC ();
771 if (NILP (POP))
772 {
773 BYTE_CODE_QUIT;
774 stack.pc += (int) *stack.pc - 128;
775 }
776 stack.pc++;
777 break;
778
779 case BRgotoifnonnil:
780 MAYBE_GC ();
781 if (!NILP (POP))
782 {
783 BYTE_CODE_QUIT;
784 stack.pc += (int) *stack.pc - 128;
785 }
786 stack.pc++;
787 break;
788
789 case BRgotoifnilelsepop:
790 MAYBE_GC ();
791 op = *stack.pc++;
792 if (NILP (TOP))
793 {
794 BYTE_CODE_QUIT;
795 stack.pc += op - 128;
796 }
797 else DISCARD (1);
798 break;
799
800 case BRgotoifnonnilelsepop:
801 MAYBE_GC ();
802 op = *stack.pc++;
803 if (!NILP (TOP))
804 {
805 BYTE_CODE_QUIT;
806 stack.pc += op - 128;
807 }
808 else DISCARD (1);
809 break;
810
811 case Breturn:
812 result = POP;
813 goto exit;
814
815 case Bdiscard:
816 DISCARD (1);
817 break;
818
819 case Bconstant2:
820 PUSH (vectorp[FETCH2]);
821 break;
822
823 case Bsave_excursion:
824 record_unwind_protect (save_excursion_restore,
825 save_excursion_save ());
826 break;
827
828 case Bsave_current_buffer:
829 case Bsave_current_buffer_1:
830 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
831 break;
832
833 case Bsave_window_excursion:
834 BEFORE_POTENTIAL_GC ();
835 TOP = Fsave_window_excursion (TOP);
836 AFTER_POTENTIAL_GC ();
837 break;
838
839 case Bsave_restriction:
840 record_unwind_protect (save_restriction_restore,
841 save_restriction_save ());
842 break;
843
844 case Bcatch:
845 {
846 Lisp_Object v1;
847 BEFORE_POTENTIAL_GC ();
848 v1 = POP;
849 TOP = internal_catch (TOP, Feval, v1);
850 AFTER_POTENTIAL_GC ();
851 break;
852 }
853
854 case Bunwind_protect:
855 record_unwind_protect (Fprogn, POP);
856 break;
857
858 case Bcondition_case:
859 {
860 Lisp_Object v1;
861 v1 = POP;
862 v1 = Fcons (POP, v1);
863 BEFORE_POTENTIAL_GC ();
864 TOP = Fcondition_case (Fcons (TOP, v1));
865 AFTER_POTENTIAL_GC ();
866 break;
867 }
868
869 case Btemp_output_buffer_setup:
870 BEFORE_POTENTIAL_GC ();
871 CHECK_STRING (TOP);
872 temp_output_buffer_setup (SDATA (TOP));
873 AFTER_POTENTIAL_GC ();
874 TOP = Vstandard_output;
875 break;
876
877 case Btemp_output_buffer_show:
878 {
879 Lisp_Object v1;
880 BEFORE_POTENTIAL_GC ();
881 v1 = POP;
882 temp_output_buffer_show (TOP);
883 TOP = v1;
884 /* pop binding of standard-output */
885 unbind_to (SPECPDL_INDEX () - 1, Qnil);
886 AFTER_POTENTIAL_GC ();
887 break;
888 }
889
890 case Bnth:
891 {
892 Lisp_Object v1, v2;
893 BEFORE_POTENTIAL_GC ();
894 v1 = POP;
895 v2 = TOP;
896 CHECK_NUMBER (v2);
897 AFTER_POTENTIAL_GC ();
898 op = XINT (v2);
899 immediate_quit = 1;
900 while (--op >= 0)
901 {
902 if (CONSP (v1))
903 v1 = XCDR (v1);
904 else if (!NILP (v1))
905 {
906 immediate_quit = 0;
907 wrong_type_argument (Qlistp, v1);
908 }
909 }
910 immediate_quit = 0;
911 if (CONSP (v1))
912 TOP = XCAR (v1);
913 else if (NILP (v1))
914 TOP = Qnil;
915 else
916 wrong_type_argument (Qlistp, v1);
917 break;
918 }
919
920 case Bsymbolp:
921 TOP = SYMBOLP (TOP) ? Qt : Qnil;
922 break;
923
924 case Bconsp:
925 TOP = CONSP (TOP) ? Qt : Qnil;
926 break;
927
928 case Bstringp:
929 TOP = STRINGP (TOP) ? Qt : Qnil;
930 break;
931
932 case Blistp:
933 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
934 break;
935
936 case Bnot:
937 TOP = NILP (TOP) ? Qt : Qnil;
938 break;
939
940 case Bcons:
941 {
942 Lisp_Object v1;
943 v1 = POP;
944 TOP = Fcons (TOP, v1);
945 break;
946 }
947
948 case Blist1:
949 TOP = Fcons (TOP, Qnil);
950 break;
951
952 case Blist2:
953 {
954 Lisp_Object v1;
955 v1 = POP;
956 TOP = Fcons (TOP, Fcons (v1, Qnil));
957 break;
958 }
959
960 case Blist3:
961 DISCARD (2);
962 TOP = Flist (3, &TOP);
963 break;
964
965 case Blist4:
966 DISCARD (3);
967 TOP = Flist (4, &TOP);
968 break;
969
970 case BlistN:
971 op = FETCH;
972 DISCARD (op - 1);
973 TOP = Flist (op, &TOP);
974 break;
975
976 case Blength:
977 BEFORE_POTENTIAL_GC ();
978 TOP = Flength (TOP);
979 AFTER_POTENTIAL_GC ();
980 break;
981
982 case Baref:
983 {
984 Lisp_Object v1;
985 BEFORE_POTENTIAL_GC ();
986 v1 = POP;
987 TOP = Faref (TOP, v1);
988 AFTER_POTENTIAL_GC ();
989 break;
990 }
991
992 case Baset:
993 {
994 Lisp_Object v1, v2;
995 BEFORE_POTENTIAL_GC ();
996 v2 = POP; v1 = POP;
997 TOP = Faset (TOP, v1, v2);
998 AFTER_POTENTIAL_GC ();
999 break;
1000 }
1001
1002 case Bsymbol_value:
1003 BEFORE_POTENTIAL_GC ();
1004 TOP = Fsymbol_value (TOP);
1005 AFTER_POTENTIAL_GC ();
1006 break;
1007
1008 case Bsymbol_function:
1009 BEFORE_POTENTIAL_GC ();
1010 TOP = Fsymbol_function (TOP);
1011 AFTER_POTENTIAL_GC ();
1012 break;
1013
1014 case Bset:
1015 {
1016 Lisp_Object v1;
1017 BEFORE_POTENTIAL_GC ();
1018 v1 = POP;
1019 TOP = Fset (TOP, v1);
1020 AFTER_POTENTIAL_GC ();
1021 break;
1022 }
1023
1024 case Bfset:
1025 {
1026 Lisp_Object v1;
1027 BEFORE_POTENTIAL_GC ();
1028 v1 = POP;
1029 TOP = Ffset (TOP, v1);
1030 AFTER_POTENTIAL_GC ();
1031 break;
1032 }
1033
1034 case Bget:
1035 {
1036 Lisp_Object v1;
1037 BEFORE_POTENTIAL_GC ();
1038 v1 = POP;
1039 TOP = Fget (TOP, v1);
1040 AFTER_POTENTIAL_GC ();
1041 break;
1042 }
1043
1044 case Bsubstring:
1045 {
1046 Lisp_Object v1, v2;
1047 BEFORE_POTENTIAL_GC ();
1048 v2 = POP; v1 = POP;
1049 TOP = Fsubstring (TOP, v1, v2);
1050 AFTER_POTENTIAL_GC ();
1051 break;
1052 }
1053
1054 case Bconcat2:
1055 BEFORE_POTENTIAL_GC ();
1056 DISCARD (1);
1057 TOP = Fconcat (2, &TOP);
1058 AFTER_POTENTIAL_GC ();
1059 break;
1060
1061 case Bconcat3:
1062 BEFORE_POTENTIAL_GC ();
1063 DISCARD (2);
1064 TOP = Fconcat (3, &TOP);
1065 AFTER_POTENTIAL_GC ();
1066 break;
1067
1068 case Bconcat4:
1069 BEFORE_POTENTIAL_GC ();
1070 DISCARD (3);
1071 TOP = Fconcat (4, &TOP);
1072 AFTER_POTENTIAL_GC ();
1073 break;
1074
1075 case BconcatN:
1076 op = FETCH;
1077 BEFORE_POTENTIAL_GC ();
1078 DISCARD (op - 1);
1079 TOP = Fconcat (op, &TOP);
1080 AFTER_POTENTIAL_GC ();
1081 break;
1082
1083 case Bsub1:
1084 {
1085 Lisp_Object v1;
1086 v1 = TOP;
1087 if (INTEGERP (v1))
1088 {
1089 XSETINT (v1, XINT (v1) - 1);
1090 TOP = v1;
1091 }
1092 else
1093 {
1094 BEFORE_POTENTIAL_GC ();
1095 TOP = Fsub1 (v1);
1096 AFTER_POTENTIAL_GC ();
1097 }
1098 break;
1099 }
1100
1101 case Badd1:
1102 {
1103 Lisp_Object v1;
1104 v1 = TOP;
1105 if (INTEGERP (v1))
1106 {
1107 XSETINT (v1, XINT (v1) + 1);
1108 TOP = v1;
1109 }
1110 else
1111 {
1112 BEFORE_POTENTIAL_GC ();
1113 TOP = Fadd1 (v1);
1114 AFTER_POTENTIAL_GC ();
1115 }
1116 break;
1117 }
1118
1119 case Beqlsign:
1120 {
1121 Lisp_Object v1, v2;
1122 BEFORE_POTENTIAL_GC ();
1123 v2 = POP; v1 = TOP;
1124 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1125 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1126 AFTER_POTENTIAL_GC ();
1127 if (FLOATP (v1) || FLOATP (v2))
1128 {
1129 double f1, f2;
1130
1131 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
1132 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1133 TOP = (f1 == f2 ? Qt : Qnil);
1134 }
1135 else
1136 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
1137 break;
1138 }
1139
1140 case Bgtr:
1141 {
1142 Lisp_Object v1;
1143 BEFORE_POTENTIAL_GC ();
1144 v1 = POP;
1145 TOP = Fgtr (TOP, v1);
1146 AFTER_POTENTIAL_GC ();
1147 break;
1148 }
1149
1150 case Blss:
1151 {
1152 Lisp_Object v1;
1153 BEFORE_POTENTIAL_GC ();
1154 v1 = POP;
1155 TOP = Flss (TOP, v1);
1156 AFTER_POTENTIAL_GC ();
1157 break;
1158 }
1159
1160 case Bleq:
1161 {
1162 Lisp_Object v1;
1163 BEFORE_POTENTIAL_GC ();
1164 v1 = POP;
1165 TOP = Fleq (TOP, v1);
1166 AFTER_POTENTIAL_GC ();
1167 break;
1168 }
1169
1170 case Bgeq:
1171 {
1172 Lisp_Object v1;
1173 BEFORE_POTENTIAL_GC ();
1174 v1 = POP;
1175 TOP = Fgeq (TOP, v1);
1176 AFTER_POTENTIAL_GC ();
1177 break;
1178 }
1179
1180 case Bdiff:
1181 BEFORE_POTENTIAL_GC ();
1182 DISCARD (1);
1183 TOP = Fminus (2, &TOP);
1184 AFTER_POTENTIAL_GC ();
1185 break;
1186
1187 case Bnegate:
1188 {
1189 Lisp_Object v1;
1190 v1 = TOP;
1191 if (INTEGERP (v1))
1192 {
1193 XSETINT (v1, - XINT (v1));
1194 TOP = v1;
1195 }
1196 else
1197 {
1198 BEFORE_POTENTIAL_GC ();
1199 TOP = Fminus (1, &TOP);
1200 AFTER_POTENTIAL_GC ();
1201 }
1202 break;
1203 }
1204
1205 case Bplus:
1206 BEFORE_POTENTIAL_GC ();
1207 DISCARD (1);
1208 TOP = Fplus (2, &TOP);
1209 AFTER_POTENTIAL_GC ();
1210 break;
1211
1212 case Bmax:
1213 BEFORE_POTENTIAL_GC ();
1214 DISCARD (1);
1215 TOP = Fmax (2, &TOP);
1216 AFTER_POTENTIAL_GC ();
1217 break;
1218
1219 case Bmin:
1220 BEFORE_POTENTIAL_GC ();
1221 DISCARD (1);
1222 TOP = Fmin (2, &TOP);
1223 AFTER_POTENTIAL_GC ();
1224 break;
1225
1226 case Bmult:
1227 BEFORE_POTENTIAL_GC ();
1228 DISCARD (1);
1229 TOP = Ftimes (2, &TOP);
1230 AFTER_POTENTIAL_GC ();
1231 break;
1232
1233 case Bquo:
1234 BEFORE_POTENTIAL_GC ();
1235 DISCARD (1);
1236 TOP = Fquo (2, &TOP);
1237 AFTER_POTENTIAL_GC ();
1238 break;
1239
1240 case Brem:
1241 {
1242 Lisp_Object v1;
1243 BEFORE_POTENTIAL_GC ();
1244 v1 = POP;
1245 TOP = Frem (TOP, v1);
1246 AFTER_POTENTIAL_GC ();
1247 break;
1248 }
1249
1250 case Bpoint:
1251 {
1252 Lisp_Object v1;
1253 XSETFASTINT (v1, PT);
1254 PUSH (v1);
1255 break;
1256 }
1257
1258 case Bgoto_char:
1259 BEFORE_POTENTIAL_GC ();
1260 TOP = Fgoto_char (TOP);
1261 AFTER_POTENTIAL_GC ();
1262 break;
1263
1264 case Binsert:
1265 BEFORE_POTENTIAL_GC ();
1266 TOP = Finsert (1, &TOP);
1267 AFTER_POTENTIAL_GC ();
1268 break;
1269
1270 case BinsertN:
1271 op = FETCH;
1272 BEFORE_POTENTIAL_GC ();
1273 DISCARD (op - 1);
1274 TOP = Finsert (op, &TOP);
1275 AFTER_POTENTIAL_GC ();
1276 break;
1277
1278 case Bpoint_max:
1279 {
1280 Lisp_Object v1;
1281 XSETFASTINT (v1, ZV);
1282 PUSH (v1);
1283 break;
1284 }
1285
1286 case Bpoint_min:
1287 {
1288 Lisp_Object v1;
1289 XSETFASTINT (v1, BEGV);
1290 PUSH (v1);
1291 break;
1292 }
1293
1294 case Bchar_after:
1295 BEFORE_POTENTIAL_GC ();
1296 TOP = Fchar_after (TOP);
1297 AFTER_POTENTIAL_GC ();
1298 break;
1299
1300 case Bfollowing_char:
1301 {
1302 Lisp_Object v1;
1303 BEFORE_POTENTIAL_GC ();
1304 v1 = Ffollowing_char ();
1305 AFTER_POTENTIAL_GC ();
1306 PUSH (v1);
1307 break;
1308 }
1309
1310 case Bpreceding_char:
1311 {
1312 Lisp_Object v1;
1313 BEFORE_POTENTIAL_GC ();
1314 v1 = Fprevious_char ();
1315 AFTER_POTENTIAL_GC ();
1316 PUSH (v1);
1317 break;
1318 }
1319
1320 case Bcurrent_column:
1321 {
1322 Lisp_Object v1;
1323 BEFORE_POTENTIAL_GC ();
1324 XSETFASTINT (v1, (int) current_column ()); /* iftc */
1325 AFTER_POTENTIAL_GC ();
1326 PUSH (v1);
1327 break;
1328 }
1329
1330 case Bindent_to:
1331 BEFORE_POTENTIAL_GC ();
1332 TOP = Findent_to (TOP, Qnil);
1333 AFTER_POTENTIAL_GC ();
1334 break;
1335
1336 case Beolp:
1337 PUSH (Feolp ());
1338 break;
1339
1340 case Beobp:
1341 PUSH (Feobp ());
1342 break;
1343
1344 case Bbolp:
1345 PUSH (Fbolp ());
1346 break;
1347
1348 case Bbobp:
1349 PUSH (Fbobp ());
1350 break;
1351
1352 case Bcurrent_buffer:
1353 PUSH (Fcurrent_buffer ());
1354 break;
1355
1356 case Bset_buffer:
1357 BEFORE_POTENTIAL_GC ();
1358 TOP = Fset_buffer (TOP);
1359 AFTER_POTENTIAL_GC ();
1360 break;
1361
1362 case Binteractive_p:
1363 PUSH (Finteractive_p ());
1364 break;
1365
1366 case Bforward_char:
1367 BEFORE_POTENTIAL_GC ();
1368 TOP = Fforward_char (TOP);
1369 AFTER_POTENTIAL_GC ();
1370 break;
1371
1372 case Bforward_word:
1373 BEFORE_POTENTIAL_GC ();
1374 TOP = Fforward_word (TOP);
1375 AFTER_POTENTIAL_GC ();
1376 break;
1377
1378 case Bskip_chars_forward:
1379 {
1380 Lisp_Object v1;
1381 BEFORE_POTENTIAL_GC ();
1382 v1 = POP;
1383 TOP = Fskip_chars_forward (TOP, v1);
1384 AFTER_POTENTIAL_GC ();
1385 break;
1386 }
1387
1388 case Bskip_chars_backward:
1389 {
1390 Lisp_Object v1;
1391 BEFORE_POTENTIAL_GC ();
1392 v1 = POP;
1393 TOP = Fskip_chars_backward (TOP, v1);
1394 AFTER_POTENTIAL_GC ();
1395 break;
1396 }
1397
1398 case Bforward_line:
1399 BEFORE_POTENTIAL_GC ();
1400 TOP = Fforward_line (TOP);
1401 AFTER_POTENTIAL_GC ();
1402 break;
1403
1404 case Bchar_syntax:
1405 {
1406 int c;
1407
1408 BEFORE_POTENTIAL_GC ();
1409 CHECK_CHARACTER (TOP);
1410 AFTER_POTENTIAL_GC ();
1411 c = XFASTINT (TOP);
1412 if (NILP (current_buffer->enable_multibyte_characters))
1413 MAKE_CHAR_MULTIBYTE (c);
1414 XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
1415 }
1416 break;
1417
1418 case Bbuffer_substring:
1419 {
1420 Lisp_Object v1;
1421 BEFORE_POTENTIAL_GC ();
1422 v1 = POP;
1423 TOP = Fbuffer_substring (TOP, v1);
1424 AFTER_POTENTIAL_GC ();
1425 break;
1426 }
1427
1428 case Bdelete_region:
1429 {
1430 Lisp_Object v1;
1431 BEFORE_POTENTIAL_GC ();
1432 v1 = POP;
1433 TOP = Fdelete_region (TOP, v1);
1434 AFTER_POTENTIAL_GC ();
1435 break;
1436 }
1437
1438 case Bnarrow_to_region:
1439 {
1440 Lisp_Object v1;
1441 BEFORE_POTENTIAL_GC ();
1442 v1 = POP;
1443 TOP = Fnarrow_to_region (TOP, v1);
1444 AFTER_POTENTIAL_GC ();
1445 break;
1446 }
1447
1448 case Bwiden:
1449 BEFORE_POTENTIAL_GC ();
1450 PUSH (Fwiden ());
1451 AFTER_POTENTIAL_GC ();
1452 break;
1453
1454 case Bend_of_line:
1455 BEFORE_POTENTIAL_GC ();
1456 TOP = Fend_of_line (TOP);
1457 AFTER_POTENTIAL_GC ();
1458 break;
1459
1460 case Bset_marker:
1461 {
1462 Lisp_Object v1, v2;
1463 BEFORE_POTENTIAL_GC ();
1464 v1 = POP;
1465 v2 = POP;
1466 TOP = Fset_marker (TOP, v2, v1);
1467 AFTER_POTENTIAL_GC ();
1468 break;
1469 }
1470
1471 case Bmatch_beginning:
1472 BEFORE_POTENTIAL_GC ();
1473 TOP = Fmatch_beginning (TOP);
1474 AFTER_POTENTIAL_GC ();
1475 break;
1476
1477 case Bmatch_end:
1478 BEFORE_POTENTIAL_GC ();
1479 TOP = Fmatch_end (TOP);
1480 AFTER_POTENTIAL_GC ();
1481 break;
1482
1483 case Bupcase:
1484 BEFORE_POTENTIAL_GC ();
1485 TOP = Fupcase (TOP);
1486 AFTER_POTENTIAL_GC ();
1487 break;
1488
1489 case Bdowncase:
1490 BEFORE_POTENTIAL_GC ();
1491 TOP = Fdowncase (TOP);
1492 AFTER_POTENTIAL_GC ();
1493 break;
1494
1495 case Bstringeqlsign:
1496 {
1497 Lisp_Object v1;
1498 BEFORE_POTENTIAL_GC ();
1499 v1 = POP;
1500 TOP = Fstring_equal (TOP, v1);
1501 AFTER_POTENTIAL_GC ();
1502 break;
1503 }
1504
1505 case Bstringlss:
1506 {
1507 Lisp_Object v1;
1508 BEFORE_POTENTIAL_GC ();
1509 v1 = POP;
1510 TOP = Fstring_lessp (TOP, v1);
1511 AFTER_POTENTIAL_GC ();
1512 break;
1513 }
1514
1515 case Bequal:
1516 {
1517 Lisp_Object v1;
1518 v1 = POP;
1519 TOP = Fequal (TOP, v1);
1520 break;
1521 }
1522
1523 case Bnthcdr:
1524 {
1525 Lisp_Object v1;
1526 BEFORE_POTENTIAL_GC ();
1527 v1 = POP;
1528 TOP = Fnthcdr (TOP, v1);
1529 AFTER_POTENTIAL_GC ();
1530 break;
1531 }
1532
1533 case Belt:
1534 {
1535 Lisp_Object v1, v2;
1536 if (CONSP (TOP))
1537 {
1538 /* Exchange args and then do nth. */
1539 BEFORE_POTENTIAL_GC ();
1540 v2 = POP;
1541 v1 = TOP;
1542 CHECK_NUMBER (v2);
1543 AFTER_POTENTIAL_GC ();
1544 op = XINT (v2);
1545 immediate_quit = 1;
1546 while (--op >= 0)
1547 {
1548 if (CONSP (v1))
1549 v1 = XCDR (v1);
1550 else if (!NILP (v1))
1551 {
1552 immediate_quit = 0;
1553 wrong_type_argument (Qlistp, v1);
1554 }
1555 }
1556 immediate_quit = 0;
1557 if (CONSP (v1))
1558 TOP = XCAR (v1);
1559 else if (NILP (v1))
1560 TOP = Qnil;
1561 else
1562 wrong_type_argument (Qlistp, v1);
1563 }
1564 else
1565 {
1566 BEFORE_POTENTIAL_GC ();
1567 v1 = POP;
1568 TOP = Felt (TOP, v1);
1569 AFTER_POTENTIAL_GC ();
1570 }
1571 break;
1572 }
1573
1574 case Bmember:
1575 {
1576 Lisp_Object v1;
1577 BEFORE_POTENTIAL_GC ();
1578 v1 = POP;
1579 TOP = Fmember (TOP, v1);
1580 AFTER_POTENTIAL_GC ();
1581 break;
1582 }
1583
1584 case Bassq:
1585 {
1586 Lisp_Object v1;
1587 BEFORE_POTENTIAL_GC ();
1588 v1 = POP;
1589 TOP = Fassq (TOP, v1);
1590 AFTER_POTENTIAL_GC ();
1591 break;
1592 }
1593
1594 case Bnreverse:
1595 BEFORE_POTENTIAL_GC ();
1596 TOP = Fnreverse (TOP);
1597 AFTER_POTENTIAL_GC ();
1598 break;
1599
1600 case Bsetcar:
1601 {
1602 Lisp_Object v1;
1603 BEFORE_POTENTIAL_GC ();
1604 v1 = POP;
1605 TOP = Fsetcar (TOP, v1);
1606 AFTER_POTENTIAL_GC ();
1607 break;
1608 }
1609
1610 case Bsetcdr:
1611 {
1612 Lisp_Object v1;
1613 BEFORE_POTENTIAL_GC ();
1614 v1 = POP;
1615 TOP = Fsetcdr (TOP, v1);
1616 AFTER_POTENTIAL_GC ();
1617 break;
1618 }
1619
1620 case Bcar_safe:
1621 {
1622 Lisp_Object v1;
1623 v1 = TOP;
1624 if (CONSP (v1))
1625 TOP = XCAR (v1);
1626 else
1627 TOP = Qnil;
1628 break;
1629 }
1630
1631 case Bcdr_safe:
1632 {
1633 Lisp_Object v1;
1634 v1 = TOP;
1635 if (CONSP (v1))
1636 TOP = XCDR (v1);
1637 else
1638 TOP = Qnil;
1639 break;
1640 }
1641
1642 case Bnconc:
1643 BEFORE_POTENTIAL_GC ();
1644 DISCARD (1);
1645 TOP = Fnconc (2, &TOP);
1646 AFTER_POTENTIAL_GC ();
1647 break;
1648
1649 case Bnumberp:
1650 TOP = (NUMBERP (TOP) ? Qt : Qnil);
1651 break;
1652
1653 case Bintegerp:
1654 TOP = INTEGERP (TOP) ? Qt : Qnil;
1655 break;
1656
1657 #ifdef BYTE_CODE_SAFE
1658 case Bset_mark:
1659 BEFORE_POTENTIAL_GC ();
1660 error ("set-mark is an obsolete bytecode");
1661 AFTER_POTENTIAL_GC ();
1662 break;
1663 case Bscan_buffer:
1664 BEFORE_POTENTIAL_GC ();
1665 error ("scan-buffer is an obsolete bytecode");
1666 AFTER_POTENTIAL_GC ();
1667 break;
1668 #endif
1669
1670 case 0:
1671 abort ();
1672
1673 case 255:
1674 default:
1675 #ifdef BYTE_CODE_SAFE
1676 if (op < Bconstant)
1677 {
1678 abort ();
1679 }
1680 if ((op -= Bconstant) >= const_length)
1681 {
1682 abort ();
1683 }
1684 PUSH (vectorp[op]);
1685 #else
1686 PUSH (vectorp[op - Bconstant]);
1687 #endif
1688 }
1689 }
1690
1691 exit:
1692
1693 byte_stack_list = byte_stack_list->next;
1694
1695 /* Binds and unbinds are supposed to be compiled balanced. */
1696 if (SPECPDL_INDEX () != count)
1697 #ifdef BYTE_CODE_SAFE
1698 error ("binding stack not balanced (serious byte compiler bug)");
1699 #else
1700 abort ();
1701 #endif
1702
1703 return result;
1704 }
1705
1706 void
1707 syms_of_bytecode ()
1708 {
1709 Qbytecode = intern ("byte-code");
1710 staticpro (&Qbytecode);
1711
1712 defsubr (&Sbyte_code);
1713
1714 #ifdef BYTE_CODE_METER
1715
1716 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1717 doc: /* A vector of vectors which holds a histogram of byte-code usage.
1718 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
1719 opcode CODE has been executed.
1720 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
1721 indicates how many times the byte opcodes CODE1 and CODE2 have been
1722 executed in succession. */);
1723
1724 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
1725 doc: /* If non-nil, keep profiling information on byte code usage.
1726 The variable byte-code-meter indicates how often each byte opcode is used.
1727 If a symbol has a property named `byte-code-meter' whose value is an
1728 integer, it is incremented each time that symbol's function is called. */);
1729
1730 byte_metering_on = 0;
1731 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1732 Qbyte_code_meter = intern ("byte-code-meter");
1733 staticpro (&Qbyte_code_meter);
1734 {
1735 int i = 256;
1736 while (i--)
1737 XVECTOR (Vbyte_code_meter)->contents[i] =
1738 Fmake_vector (make_number (256), make_number (0));
1739 }
1740 #endif
1741 }
1742
1743 /* arch-tag: b9803b6f-1ed6-4190-8adf-33fd3a9d10e9
1744 (do not change this comment) */