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