]> code.delx.au - gnu-emacs/blob - src/bytecode.c
delx.au / code / gnu-emacs / blob


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