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