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