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