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