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