]> code.delx.au - gnu-emacs/blob - src/bytecode.c
delx.au / code / gnu-emacs / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
(BYTE_CODE_QUIT): Check Vthrow_on_input.
[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 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 "charset.h"
41 #include "syntax.h"
42 #include "window.h"
43
44 #ifdef CHECK_FRAME_FONT
45 #include "frame.h"
46 #include "xterm.h"
47 #endif
48
49 /*
50 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
51 * debugging the byte compiler...)
52 *
53 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
54 */
55 /* #define BYTE_CODE_SAFE */
56 /* #define BYTE_CODE_METER */
57
58 \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 Lisp_Object flag = Vquit_flag; \
388 Vquit_flag = Qnil; \
389 BEFORE_POTENTIAL_GC (); \
390 if (EQ (Vthrow_on_input, flag)) \
391 Fthrow (Vthrow_on_input, Qnil); \
392 Fsignal (Qquit, Qnil); \
393 AFTER_POTENTIAL_GC (); \
394 } \
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 (bytestr, vector, maxdepth)
405 Lisp_Object bytestr, vector, maxdepth;
406 {
407 int count = SPECPDL_INDEX ();
408 #ifdef BYTE_CODE_METER
409 int this_op = 0;
410 int prev_op;
411 #endif
412 int op;
413 /* Lisp_Object v1, v2; */
414 Lisp_Object *vectorp;
415 #ifdef BYTE_CODE_SAFE
416 int const_length = XVECTOR (vector)->size;
417 Lisp_Object *stacke;
418 #endif
419 int bytestr_length;
420 struct byte_stack stack;
421 Lisp_Object *top;
422 Lisp_Object result;
423
424 #ifdef CHECK_FRAME_FONT
425 {
426 struct frame *f = SELECTED_FRAME ();
427 if (FRAME_X_P (f)
428 && FRAME_FONT (f)->direction != 0
429 && FRAME_FONT (f)->direction != 1)
430 abort ();
431 }
432 #endif
433
434 CHECK_STRING (bytestr);
435 if (!VECTORP (vector))
436 vector = wrong_type_argument (Qvectorp, vector);
437 CHECK_NUMBER (maxdepth);
438
439 if (STRING_MULTIBYTE (bytestr))
440 /* BYTESTR must have been produced by Emacs 20.2 or the earlier
441 because they produced a raw 8-bit string for byte-code and now
442 such a byte-code string is loaded as multibyte while raw 8-bit
443 characters converted to multibyte form. Thus, now we must
444 convert them back to the originally intended unibyte form. */
445 bytestr = Fstring_as_unibyte (bytestr);
446
447 bytestr_length = SBYTES (bytestr);
448 vectorp = XVECTOR (vector)->contents;
449
450 stack.byte_string = bytestr;
451 stack.pc = stack.byte_string_start = SDATA (bytestr);
452 stack.constants = vector;
453 stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth)
454 * sizeof (Lisp_Object));
455 top = stack.bottom - 1;
456 stack.top = NULL;
457 stack.next = byte_stack_list;
458 byte_stack_list = &stack;
459
460 #ifdef BYTE_CODE_SAFE
461 stacke = stack.bottom - 1 + XFASTINT (maxdepth);
462 #endif
463
464 while (1)
465 {
466 #ifdef BYTE_CODE_SAFE
467 if (top > stacke)
468 abort ();
469 else if (top < stack.bottom - 1)
470 abort ();
471 #endif
472
473 #ifdef BYTE_CODE_METER
474 prev_op = this_op;
475 this_op = op = FETCH;
476 METER_CODE (prev_op, op);
477 #else
478 op = FETCH;
479 #endif
480
481 switch (op)
482 {
483 case Bvarref + 7:
484 op = FETCH2;
485 goto varref;
486
487 case Bvarref:
488 case Bvarref + 1:
489 case Bvarref + 2:
490 case Bvarref + 3:
491 case Bvarref + 4:
492 case Bvarref + 5:
493 op = op - Bvarref;
494 goto varref;
495
496 /* This seems to be the most frequently executed byte-code
497 among the Bvarref's, so avoid a goto here. */
498 case Bvarref+6:
499 op = FETCH;
500 varref:
501 {
502 Lisp_Object v1, v2;
503
504 v1 = vectorp[op];
505 if (SYMBOLP (v1))
506 {
507 v2 = SYMBOL_VALUE (v1);
508 if (MISCP (v2) || EQ (v2, Qunbound))
509 {
510 BEFORE_POTENTIAL_GC ();
511 v2 = Fsymbol_value (v1);
512 AFTER_POTENTIAL_GC ();
513 }
514 }
515 else
516 {
517 BEFORE_POTENTIAL_GC ();
518 v2 = Fsymbol_value (v1);
519 AFTER_POTENTIAL_GC ();
520 }
521 PUSH (v2);
522 break;
523 }
524
525 case Bgotoifnil:
526 MAYBE_GC ();
527 op = FETCH2;
528 if (NILP (POP))
529 {
530 BYTE_CODE_QUIT;
531 CHECK_RANGE (op);
532 stack.pc = stack.byte_string_start + op;
533 }
534 break;
535
536 case Bcar:
537 {
538 Lisp_Object v1;
539 v1 = TOP;
540 if (CONSP (v1))
541 TOP = XCAR (v1);
542 else if (NILP (v1))
543 TOP = Qnil;
544 else
545 {
546 wrong_type_argument (Qlistp, v1);
547 }
548 break;
549 }
550
551 case Beq:
552 {
553 Lisp_Object v1;
554 v1 = POP;
555 TOP = EQ (v1, TOP) ? Qt : Qnil;
556 break;
557 }
558
559 case Bmemq:
560 {
561 Lisp_Object v1;
562 BEFORE_POTENTIAL_GC ();
563 v1 = POP;
564 TOP = Fmemq (TOP, v1);
565 AFTER_POTENTIAL_GC ();
566 break;
567 }
568
569 case Bcdr:
570 {
571 Lisp_Object v1;
572 v1 = TOP;
573 if (CONSP (v1))
574 TOP = XCDR (v1);
575 else if (NILP (v1))
576 TOP = Qnil;
577 else
578 {
579 wrong_type_argument (Qlistp, v1);
580 }
581 break;
582 }
583
584 case Bvarset:
585 case Bvarset+1:
586 case Bvarset+2:
587 case Bvarset+3:
588 case Bvarset+4:
589 case Bvarset+5:
590 op -= Bvarset;
591 goto varset;
592
593 case Bvarset+7:
594 op = FETCH2;
595 goto varset;
596
597 case Bvarset+6:
598 op = FETCH;
599 varset:
600 {
601 Lisp_Object sym, val;
602
603 sym = vectorp[op];
604 val = TOP;
605
606 /* Inline the most common case. */
607 if (SYMBOLP (sym)
608 && !EQ (val, Qunbound)
609 && !XSYMBOL (sym)->indirect_variable
610 && !XSYMBOL (sym)->constant
611 && !MISCP (XSYMBOL (sym)->value))
612 XSYMBOL (sym)->value = val;
613 else
614 {
615 BEFORE_POTENTIAL_GC ();
616 set_internal (sym, val, current_buffer, 0);
617 AFTER_POTENTIAL_GC ();
618 }
619 }
620 (void) POP;
621 break;
622
623 case Bdup:
624 {
625 Lisp_Object v1;
626 v1 = TOP;
627 PUSH (v1);
628 break;
629 }
630
631 /* ------------------ */
632
633 case Bvarbind+6:
634 op = FETCH;
635 goto varbind;
636
637 case Bvarbind+7:
638 op = FETCH2;
639 goto varbind;
640
641 case Bvarbind:
642 case Bvarbind+1:
643 case Bvarbind+2:
644 case Bvarbind+3:
645 case Bvarbind+4:
646 case Bvarbind+5:
647 op -= Bvarbind;
648 varbind:
649 /* Specbind can signal and thus GC. */
650 BEFORE_POTENTIAL_GC ();
651 specbind (vectorp[op], POP);
652 AFTER_POTENTIAL_GC ();
653 break;
654
655 case Bcall+6:
656 op = FETCH;
657 goto docall;
658
659 case Bcall+7:
660 op = FETCH2;
661 goto docall;
662
663 case Bcall:
664 case Bcall+1:
665 case Bcall+2:
666 case Bcall+3:
667 case Bcall+4:
668 case Bcall+5:
669 op -= Bcall;
670 docall:
671 {
672 BEFORE_POTENTIAL_GC ();
673 DISCARD (op);
674 #ifdef BYTE_CODE_METER
675 if (byte_metering_on && SYMBOLP (TOP))
676 {
677 Lisp_Object v1, v2;
678
679 v1 = TOP;
680 v2 = Fget (v1, Qbyte_code_meter);
681 if (INTEGERP (v2)
682 && XINT (v2) < MOST_POSITIVE_FIXNUM)
683 {
684 XSETINT (v2, XINT (v2) + 1);
685 Fput (v1, Qbyte_code_meter, v2);
686 }
687 }
688 #endif
689 TOP = Ffuncall (op + 1, &TOP);
690 AFTER_POTENTIAL_GC ();
691 break;
692 }
693
694 case Bunbind+6:
695 op = FETCH;
696 goto dounbind;
697
698 case Bunbind+7:
699 op = FETCH2;
700 goto dounbind;
701
702 case Bunbind:
703 case Bunbind+1:
704 case Bunbind+2:
705 case Bunbind+3:
706 case Bunbind+4:
707 case Bunbind+5:
708 op -= Bunbind;
709 dounbind:
710 BEFORE_POTENTIAL_GC ();
711 unbind_to (SPECPDL_INDEX () - op, Qnil);
712 AFTER_POTENTIAL_GC ();
713 break;
714
715 case Bunbind_all:
716 /* To unbind back to the beginning of this frame. Not used yet,
717 but will be needed for tail-recursion elimination. */
718 BEFORE_POTENTIAL_GC ();
719 unbind_to (count, Qnil);
720 AFTER_POTENTIAL_GC ();
721 break;
722
723 case Bgoto:
724 MAYBE_GC ();
725 BYTE_CODE_QUIT;
726 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
727 CHECK_RANGE (op);
728 stack.pc = stack.byte_string_start + op;
729 break;
730
731 case Bgotoifnonnil:
732 MAYBE_GC ();
733 op = FETCH2;
734 if (!NILP (POP))
735 {
736 BYTE_CODE_QUIT;
737 CHECK_RANGE (op);
738 stack.pc = stack.byte_string_start + op;
739 }
740 break;
741
742 case Bgotoifnilelsepop:
743 MAYBE_GC ();
744 op = FETCH2;
745 if (NILP (TOP))
746 {
747 BYTE_CODE_QUIT;
748 CHECK_RANGE (op);
749 stack.pc = stack.byte_string_start + op;
750 }
751 else DISCARD (1);
752 break;
753
754 case Bgotoifnonnilelsepop:
755 MAYBE_GC ();
756 op = FETCH2;
757 if (!NILP (TOP))
758 {
759 BYTE_CODE_QUIT;
760 CHECK_RANGE (op);
761 stack.pc = stack.byte_string_start + op;
762 }
763 else DISCARD (1);
764 break;
765
766 case BRgoto:
767 MAYBE_GC ();
768 BYTE_CODE_QUIT;
769 stack.pc += (int) *stack.pc - 127;
770 break;
771
772 case BRgotoifnil:
773 MAYBE_GC ();
774 if (NILP (POP))
775 {
776 BYTE_CODE_QUIT;
777 stack.pc += (int) *stack.pc - 128;
778 }
779 stack.pc++;
780 break;
781
782 case BRgotoifnonnil:
783 MAYBE_GC ();
784 if (!NILP (POP))
785 {
786 BYTE_CODE_QUIT;
787 stack.pc += (int) *stack.pc - 128;
788 }
789 stack.pc++;
790 break;
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 v1;
864 v1 = POP;
865 v1 = Fcons (POP, v1);
866 BEFORE_POTENTIAL_GC ();
867 TOP = Fcondition_case (Fcons (TOP, v1));
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)
904 {
905 if (CONSP (v1))
906 v1 = XCDR (v1);
907 else if (!NILP (v1))
908 {
909 immediate_quit = 0;
910 wrong_type_argument (Qlistp, v1);
911 }
912 }
913 immediate_quit = 0;
914 if (CONSP (v1))
915 TOP = XCAR (v1);
916 else if (NILP (v1))
917 TOP = Qnil;
918 else
919 wrong_type_argument (Qlistp, v1);
920 break;
921 }
922
923 case Bsymbolp:
924 TOP = SYMBOLP (TOP) ? Qt : Qnil;
925 break;
926
927 case Bconsp:
928 TOP = CONSP (TOP) ? Qt : Qnil;
929 break;
930
931 case Bstringp:
932 TOP = STRINGP (TOP) ? Qt : Qnil;
933 break;
934
935 case Blistp:
936 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
937 break;
938
939 case Bnot:
940 TOP = NILP (TOP) ? Qt : Qnil;
941 break;
942
943 case Bcons:
944 {
945 Lisp_Object v1;
946 v1 = POP;
947 TOP = Fcons (TOP, v1);
948 break;
949 }
950
951 case Blist1:
952 TOP = Fcons (TOP, Qnil);
953 break;
954
955 case Blist2:
956 {
957 Lisp_Object v1;
958 v1 = POP;
959 TOP = Fcons (TOP, Fcons (v1, Qnil));
960 break;
961 }
962
963 case Blist3:
964 DISCARD (2);
965 TOP = Flist (3, &TOP);
966 break;
967
968 case Blist4:
969 DISCARD (3);
970 TOP = Flist (4, &TOP);
971 break;
972
973 case BlistN:
974 op = FETCH;
975 DISCARD (op - 1);
976 TOP = Flist (op, &TOP);
977 break;
978
979 case Blength:
980 BEFORE_POTENTIAL_GC ();
981 TOP = Flength (TOP);
982 AFTER_POTENTIAL_GC ();
983 break;
984
985 case Baref:
986 {
987 Lisp_Object v1;
988 BEFORE_POTENTIAL_GC ();
989 v1 = POP;
990 TOP = Faref (TOP, v1);
991 AFTER_POTENTIAL_GC ();
992 break;
993 }
994
995 case Baset:
996 {
997 Lisp_Object v1, v2;
998 BEFORE_POTENTIAL_GC ();
999 v2 = POP; v1 = POP;
1000 TOP = Faset (TOP, v1, v2);
1001 AFTER_POTENTIAL_GC ();
1002 break;
1003 }
1004
1005 case Bsymbol_value:
1006 BEFORE_POTENTIAL_GC ();
1007 TOP = Fsymbol_value (TOP);
1008 AFTER_POTENTIAL_GC ();
1009 break;
1010
1011 case Bsymbol_function:
1012 BEFORE_POTENTIAL_GC ();
1013 TOP = Fsymbol_function (TOP);
1014 AFTER_POTENTIAL_GC ();
1015 break;
1016
1017 case Bset:
1018 {
1019 Lisp_Object v1;
1020 BEFORE_POTENTIAL_GC ();
1021 v1 = POP;
1022 TOP = Fset (TOP, v1);
1023 AFTER_POTENTIAL_GC ();
1024 break;
1025 }
1026
1027 case Bfset:
1028 {
1029 Lisp_Object v1;
1030 BEFORE_POTENTIAL_GC ();
1031 v1 = POP;
1032 TOP = Ffset (TOP, v1);
1033 AFTER_POTENTIAL_GC ();
1034 break;
1035 }
1036
1037 case Bget:
1038 {
1039 Lisp_Object v1;
1040 BEFORE_POTENTIAL_GC ();
1041 v1 = POP;
1042 TOP = Fget (TOP, v1);
1043 AFTER_POTENTIAL_GC ();
1044 break;
1045 }
1046
1047 case Bsubstring:
1048 {
1049 Lisp_Object v1, v2;
1050 BEFORE_POTENTIAL_GC ();
1051 v2 = POP; v1 = POP;
1052 TOP = Fsubstring (TOP, v1, v2);
1053 AFTER_POTENTIAL_GC ();
1054 break;
1055 }
1056
1057 case Bconcat2:
1058 BEFORE_POTENTIAL_GC ();
1059 DISCARD (1);
1060 TOP = Fconcat (2, &TOP);
1061 AFTER_POTENTIAL_GC ();
1062 break;
1063
1064 case Bconcat3:
1065 BEFORE_POTENTIAL_GC ();
1066 DISCARD (2);
1067 TOP = Fconcat (3, &TOP);
1068 AFTER_POTENTIAL_GC ();
1069 break;
1070
1071 case Bconcat4:
1072 BEFORE_POTENTIAL_GC ();
1073 DISCARD (3);
1074 TOP = Fconcat (4, &TOP);
1075 AFTER_POTENTIAL_GC ();
1076 break;
1077
1078 case BconcatN:
1079 op = FETCH;
1080 BEFORE_POTENTIAL_GC ();
1081 DISCARD (op - 1);
1082 TOP = Fconcat (op, &TOP);
1083 AFTER_POTENTIAL_GC ();
1084 break;
1085
1086 case Bsub1:
1087 {
1088 Lisp_Object v1;
1089 v1 = TOP;
1090 if (INTEGERP (v1))
1091 {
1092 XSETINT (v1, XINT (v1) - 1);
1093 TOP = v1;
1094 }
1095 else
1096 {
1097 BEFORE_POTENTIAL_GC ();
1098 TOP = Fsub1 (v1);
1099 AFTER_POTENTIAL_GC ();
1100 }
1101 break;
1102 }
1103
1104 case Badd1:
1105 {
1106 Lisp_Object v1;
1107 v1 = TOP;
1108 if (INTEGERP (v1))
1109 {
1110 XSETINT (v1, XINT (v1) + 1);
1111 TOP = v1;
1112 }
1113 else
1114 {
1115 BEFORE_POTENTIAL_GC ();
1116 TOP = Fadd1 (v1);
1117 AFTER_POTENTIAL_GC ();
1118 }
1119 break;
1120 }
1121
1122 case Beqlsign:
1123 {
1124 Lisp_Object v1, v2;
1125 BEFORE_POTENTIAL_GC ();
1126 v2 = POP; v1 = TOP;
1127 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1128 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1129 AFTER_POTENTIAL_GC ();
1130 if (FLOATP (v1) || FLOATP (v2))
1131 {
1132 double f1, f2;
1133
1134 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
1135 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1136 TOP = (f1 == f2 ? Qt : Qnil);
1137 }
1138 else
1139 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
1140 break;
1141 }
1142
1143 case Bgtr:
1144 {
1145 Lisp_Object v1;
1146 BEFORE_POTENTIAL_GC ();
1147 v1 = POP;
1148 TOP = Fgtr (TOP, v1);
1149 AFTER_POTENTIAL_GC ();
1150 break;
1151 }
1152
1153 case Blss:
1154 {
1155 Lisp_Object v1;
1156 BEFORE_POTENTIAL_GC ();
1157 v1 = POP;
1158 TOP = Flss (TOP, v1);
1159 AFTER_POTENTIAL_GC ();
1160 break;
1161 }
1162
1163 case Bleq:
1164 {
1165 Lisp_Object v1;
1166 BEFORE_POTENTIAL_GC ();
1167 v1 = POP;
1168 TOP = Fleq (TOP, v1);
1169 AFTER_POTENTIAL_GC ();
1170 break;
1171 }
1172
1173 case Bgeq:
1174 {
1175 Lisp_Object v1;
1176 BEFORE_POTENTIAL_GC ();
1177 v1 = POP;
1178 TOP = Fgeq (TOP, v1);
1179 AFTER_POTENTIAL_GC ();
1180 break;
1181 }
1182
1183 case Bdiff:
1184 BEFORE_POTENTIAL_GC ();
1185 DISCARD (1);
1186 TOP = Fminus (2, &TOP);
1187 AFTER_POTENTIAL_GC ();
1188 break;
1189
1190 case Bnegate:
1191 {
1192 Lisp_Object v1;
1193 v1 = TOP;
1194 if (INTEGERP (v1))
1195 {
1196 XSETINT (v1, - XINT (v1));
1197 TOP = v1;
1198 }
1199 else
1200 {
1201 BEFORE_POTENTIAL_GC ();
1202 TOP = Fminus (1, &TOP);
1203 AFTER_POTENTIAL_GC ();
1204 }
1205 break;
1206 }
1207
1208 case Bplus:
1209 BEFORE_POTENTIAL_GC ();
1210 DISCARD (1);
1211 TOP = Fplus (2, &TOP);
1212 AFTER_POTENTIAL_GC ();
1213 break;
1214
1215 case Bmax:
1216 BEFORE_POTENTIAL_GC ();
1217 DISCARD (1);
1218 TOP = Fmax (2, &TOP);
1219 AFTER_POTENTIAL_GC ();
1220 break;
1221
1222 case Bmin:
1223 BEFORE_POTENTIAL_GC ();
1224 DISCARD (1);
1225 TOP = Fmin (2, &TOP);
1226 AFTER_POTENTIAL_GC ();
1227 break;
1228
1229 case Bmult:
1230 BEFORE_POTENTIAL_GC ();
1231 DISCARD (1);
1232 TOP = Ftimes (2, &TOP);
1233 AFTER_POTENTIAL_GC ();
1234 break;
1235
1236 case Bquo:
1237 BEFORE_POTENTIAL_GC ();
1238 DISCARD (1);
1239 TOP = Fquo (2, &TOP);
1240 AFTER_POTENTIAL_GC ();
1241 break;
1242
1243 case Brem:
1244 {
1245 Lisp_Object v1;
1246 BEFORE_POTENTIAL_GC ();
1247 v1 = POP;
1248 TOP = Frem (TOP, v1);
1249 AFTER_POTENTIAL_GC ();
1250 break;
1251 }
1252
1253 case Bpoint:
1254 {
1255 Lisp_Object v1;
1256 XSETFASTINT (v1, PT);
1257 PUSH (v1);
1258 break;
1259 }
1260
1261 case Bgoto_char:
1262 BEFORE_POTENTIAL_GC ();
1263 TOP = Fgoto_char (TOP);
1264 AFTER_POTENTIAL_GC ();
1265 break;
1266
1267 case Binsert:
1268 BEFORE_POTENTIAL_GC ();
1269 TOP = Finsert (1, &TOP);
1270 AFTER_POTENTIAL_GC ();
1271 break;
1272
1273 case BinsertN:
1274 op = FETCH;
1275 BEFORE_POTENTIAL_GC ();
1276 DISCARD (op - 1);
1277 TOP = Finsert (op, &TOP);
1278 AFTER_POTENTIAL_GC ();
1279 break;
1280
1281 case Bpoint_max:
1282 {
1283 Lisp_Object v1;
1284 XSETFASTINT (v1, ZV);
1285 PUSH (v1);
1286 break;
1287 }
1288
1289 case Bpoint_min:
1290 {
1291 Lisp_Object v1;
1292 XSETFASTINT (v1, BEGV);
1293 PUSH (v1);
1294 break;
1295 }
1296
1297 case Bchar_after:
1298 BEFORE_POTENTIAL_GC ();
1299 TOP = Fchar_after (TOP);
1300 AFTER_POTENTIAL_GC ();
1301 break;
1302
1303 case Bfollowing_char:
1304 {
1305 Lisp_Object v1;
1306 BEFORE_POTENTIAL_GC ();
1307 v1 = Ffollowing_char ();
1308 AFTER_POTENTIAL_GC ();
1309 PUSH (v1);
1310 break;
1311 }
1312
1313 case Bpreceding_char:
1314 {
1315 Lisp_Object v1;
1316 BEFORE_POTENTIAL_GC ();
1317 v1 = Fprevious_char ();
1318 AFTER_POTENTIAL_GC ();
1319 PUSH (v1);
1320 break;
1321 }
1322
1323 case Bcurrent_column:
1324 {
1325 Lisp_Object v1;
1326 BEFORE_POTENTIAL_GC ();
1327 XSETFASTINT (v1, (int) current_column ()); /* iftc */
1328 AFTER_POTENTIAL_GC ();
1329 PUSH (v1);
1330 break;
1331 }
1332
1333 case Bindent_to:
1334 BEFORE_POTENTIAL_GC ();
1335 TOP = Findent_to (TOP, Qnil);
1336 AFTER_POTENTIAL_GC ();
1337 break;
1338
1339 case Beolp:
1340 PUSH (Feolp ());
1341 break;
1342
1343 case Beobp:
1344 PUSH (Feobp ());
1345 break;
1346
1347 case Bbolp:
1348 PUSH (Fbolp ());
1349 break;
1350
1351 case Bbobp:
1352 PUSH (Fbobp ());
1353 break;
1354
1355 case Bcurrent_buffer:
1356 PUSH (Fcurrent_buffer ());
1357 break;
1358
1359 case Bset_buffer:
1360 BEFORE_POTENTIAL_GC ();
1361 TOP = Fset_buffer (TOP);
1362 AFTER_POTENTIAL_GC ();
1363 break;
1364
1365 case Binteractive_p:
1366 PUSH (Finteractive_p ());
1367 break;
1368
1369 case Bforward_char:
1370 BEFORE_POTENTIAL_GC ();
1371 TOP = Fforward_char (TOP);
1372 AFTER_POTENTIAL_GC ();
1373 break;
1374
1375 case Bforward_word:
1376 BEFORE_POTENTIAL_GC ();
1377 TOP = Fforward_word (TOP);
1378 AFTER_POTENTIAL_GC ();
1379 break;
1380
1381 case Bskip_chars_forward:
1382 {
1383 Lisp_Object v1;
1384 BEFORE_POTENTIAL_GC ();
1385 v1 = POP;
1386 TOP = Fskip_chars_forward (TOP, v1);
1387 AFTER_POTENTIAL_GC ();
1388 break;
1389 }
1390
1391 case Bskip_chars_backward:
1392 {
1393 Lisp_Object v1;
1394 BEFORE_POTENTIAL_GC ();
1395 v1 = POP;
1396 TOP = Fskip_chars_backward (TOP, v1);
1397 AFTER_POTENTIAL_GC ();
1398 break;
1399 }
1400
1401 case Bforward_line:
1402 BEFORE_POTENTIAL_GC ();
1403 TOP = Fforward_line (TOP);
1404 AFTER_POTENTIAL_GC ();
1405 break;
1406
1407 case Bchar_syntax:
1408 BEFORE_POTENTIAL_GC ();
1409 CHECK_NUMBER (TOP);
1410 AFTER_POTENTIAL_GC ();
1411 XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
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)
1543 {
1544 if (CONSP (v1))
1545 v1 = XCDR (v1);
1546 else if (!NILP (v1))
1547 {
1548 immediate_quit = 0;
1549 wrong_type_argument (Qlistp, v1);
1550 }
1551 }
1552 immediate_quit = 0;
1553 if (CONSP (v1))
1554 TOP = XCAR (v1);
1555 else if (NILP (v1))
1556 TOP = Qnil;
1557 else
1558 wrong_type_argument (Qlistp, v1);
1559 }
1560 else
1561 {
1562 BEFORE_POTENTIAL_GC ();
1563 v1 = POP;
1564 TOP = Felt (TOP, v1);
1565 AFTER_POTENTIAL_GC ();
1566 }
1567 break;
1568 }
1569
1570 case Bmember:
1571 {
1572 Lisp_Object v1;
1573 BEFORE_POTENTIAL_GC ();
1574 v1 = POP;
1575 TOP = Fmember (TOP, v1);
1576 AFTER_POTENTIAL_GC ();
1577 break;
1578 }
1579
1580 case Bassq:
1581 {
1582 Lisp_Object v1;
1583 BEFORE_POTENTIAL_GC ();
1584 v1 = POP;
1585 TOP = Fassq (TOP, v1);
1586 AFTER_POTENTIAL_GC ();
1587 break;
1588 }
1589
1590 case Bnreverse:
1591 BEFORE_POTENTIAL_GC ();
1592 TOP = Fnreverse (TOP);
1593 AFTER_POTENTIAL_GC ();
1594 break;
1595
1596 case Bsetcar:
1597 {
1598 Lisp_Object v1;
1599 BEFORE_POTENTIAL_GC ();
1600 v1 = POP;
1601 TOP = Fsetcar (TOP, v1);
1602 AFTER_POTENTIAL_GC ();
1603 break;
1604 }
1605
1606 case Bsetcdr:
1607 {
1608 Lisp_Object v1;
1609 BEFORE_POTENTIAL_GC ();
1610 v1 = POP;
1611 TOP = Fsetcdr (TOP, v1);
1612 AFTER_POTENTIAL_GC ();
1613 break;
1614 }
1615
1616 case Bcar_safe:
1617 {
1618 Lisp_Object v1;
1619 v1 = TOP;
1620 if (CONSP (v1))
1621 TOP = XCAR (v1);
1622 else
1623 TOP = Qnil;
1624 break;
1625 }
1626
1627 case Bcdr_safe:
1628 {
1629 Lisp_Object v1;
1630 v1 = TOP;
1631 if (CONSP (v1))
1632 TOP = XCDR (v1);
1633 else
1634 TOP = Qnil;
1635 break;
1636 }
1637
1638 case Bnconc:
1639 BEFORE_POTENTIAL_GC ();
1640 DISCARD (1);
1641 TOP = Fnconc (2, &TOP);
1642 AFTER_POTENTIAL_GC ();
1643 break;
1644
1645 case Bnumberp:
1646 TOP = (NUMBERP (TOP) ? Qt : Qnil);
1647 break;
1648
1649 case Bintegerp:
1650 TOP = INTEGERP (TOP) ? Qt : Qnil;
1651 break;
1652
1653 #ifdef BYTE_CODE_SAFE
1654 case Bset_mark:
1655 BEFORE_POTENTIAL_GC ();
1656 error ("set-mark is an obsolete bytecode");
1657 AFTER_POTENTIAL_GC ();
1658 break;
1659 case Bscan_buffer:
1660 BEFORE_POTENTIAL_GC ();
1661 error ("scan-buffer is an obsolete bytecode");
1662 AFTER_POTENTIAL_GC ();
1663 break;
1664 #endif
1665
1666 case 0:
1667 abort ();
1668
1669 case 255:
1670 default:
1671 #ifdef BYTE_CODE_SAFE
1672 if (op < Bconstant)
1673 {
1674 abort ();
1675 }
1676 if ((op -= Bconstant) >= const_length)
1677 {
1678 abort ();
1679 }
1680 PUSH (vectorp[op]);
1681 #else
1682 PUSH (vectorp[op - Bconstant]);
1683 #endif
1684 }
1685 }
1686
1687 exit:
1688
1689 byte_stack_list = byte_stack_list->next;
1690
1691 /* Binds and unbinds are supposed to be compiled balanced. */
1692 if (SPECPDL_INDEX () != count)
1693 #ifdef BYTE_CODE_SAFE
1694 error ("binding stack not balanced (serious byte compiler bug)");
1695 #else
1696 abort ();
1697 #endif
1698
1699 return result;
1700 }
1701
1702 void
1703 syms_of_bytecode ()
1704 {
1705 Qbytecode = intern ("byte-code");
1706 staticpro (&Qbytecode);
1707
1708 defsubr (&Sbyte_code);
1709
1710 #ifdef BYTE_CODE_METER
1711
1712 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1713 doc: /* A vector of vectors which holds a histogram of byte-code usage.
1714 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
1715 opcode CODE has been executed.
1716 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
1717 indicates how many times the byte opcodes CODE1 and CODE2 have been
1718 executed in succession. */);
1719
1720 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
1721 doc: /* If non-nil, keep profiling information on byte code usage.
1722 The variable byte-code-meter indicates how often each byte opcode is used.
1723 If a symbol has a property named `byte-code-meter' whose value is an
1724 integer, it is incremented each time that symbol's function is called. */);
1725
1726 byte_metering_on = 0;
1727 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1728 Qbyte_code_meter = intern ("byte-code-meter");
1729 staticpro (&Qbyte_code_meter);
1730 {
1731 int i = 256;
1732 while (i--)
1733 XVECTOR (Vbyte_code_meter)->contents[i] =
1734 Fmake_vector (make_number (256), make_number (0));
1735 }
1736 #endif
1737 }
1738
1739 /* arch-tag: b9803b6f-1ed6-4190-8adf-33fd3a9d10e9
1740 (do not change this comment) */