HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Convert (most) functions in src to standard C.
[bpt/emacs.git] / src / bytecode.c
1 /* Execution of byte code produced by bytecomp.el.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008, 2009, 2010 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 3 of the License, or
10 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
19
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 <setjmp.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 (void)
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 (void)
305 {
306 struct byte_stack *stack;
307
308 for (stack = byte_stack_list; stack; stack = stack->next)
309 {
310 if (stack->byte_string_start != SDATA (stack->byte_string))
311 {
312 int offset = stack->pc - stack->byte_string_start;
313 stack->byte_string_start = SDATA (stack->byte_string);
314 stack->pc = stack->byte_string_start + offset;
315 }
316 }
317 }
318
319 \f
320 /* Fetch the next byte from the bytecode stream */
321
322 #define FETCH *stack.pc++
323
324 /* Fetch two bytes from the bytecode stream and make a 16-bit number
325 out of them */
326
327 #define FETCH2 (op = FETCH, op + (FETCH << 8))
328
329 /* Push x onto the execution stack. This used to be #define PUSH(x)
330 (*++stackp = (x)) This oddity is necessary because Alliant can't be
331 bothered to compile the preincrement operator properly, as of 4/91.
332 -JimB */
333
334 #define PUSH(x) (top++, *top = (x))
335
336 /* Pop a value off the execution stack. */
337
338 #define POP (*top--)
339
340 /* Discard n values from the execution stack. */
341
342 #define DISCARD(n) (top -= (n))
343
344 /* Get the value which is at the top of the execution stack, but don't
345 pop it. */
346
347 #define TOP (*top)
348
349 /* Actions that must be performed before and after calling a function
350 that might GC. */
351
352 #define BEFORE_POTENTIAL_GC() stack.top = top
353 #define AFTER_POTENTIAL_GC() stack.top = NULL
354
355 /* Garbage collect if we have consed enough since the last time.
356 We do this at every branch, to avoid loops that never GC. */
357
358 #define MAYBE_GC() \
359 if (consing_since_gc > gc_cons_threshold \
360 && consing_since_gc > gc_relative_threshold) \
361 { \
362 BEFORE_POTENTIAL_GC (); \
363 Fgarbage_collect (); \
364 AFTER_POTENTIAL_GC (); \
365 } \
366 else
367
368 /* Check for jumping out of range. */
369
370 #ifdef BYTE_CODE_SAFE
371
372 #define CHECK_RANGE(ARG) \
373 if (ARG >= bytestr_length) abort ()
374
375 #else /* not BYTE_CODE_SAFE */
376
377 #define CHECK_RANGE(ARG)
378
379 #endif /* not BYTE_CODE_SAFE */
380
381 /* A version of the QUIT macro which makes sure that the stack top is
382 set before signaling `quit'. */
383
384 #define BYTE_CODE_QUIT \
385 do { \
386 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
387 { \
388 Lisp_Object flag = Vquit_flag; \
389 Vquit_flag = Qnil; \
390 BEFORE_POTENTIAL_GC (); \
391 if (EQ (Vthrow_on_input, flag)) \
392 Fthrow (Vthrow_on_input, Qt); \
393 Fsignal (Qquit, Qnil); \
394 AFTER_POTENTIAL_GC (); \
395 } \
396 ELSE_PENDING_SIGNALS \
397 } while (0)
398
399
400 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
401 doc: /* Function used internally in byte-compiled code.
402 The first argument, BYTESTR, is a string of byte code;
403 the second, VECTOR, a vector of constants;
404 the third, MAXDEPTH, the maximum stack depth used in this function.
405 If the third argument is incorrect, Emacs may crash. */)
406 (bytestr, vector, maxdepth)
407 Lisp_Object bytestr, vector, maxdepth;
408 {
409 int count = SPECPDL_INDEX ();
410 #ifdef BYTE_CODE_METER
411 int this_op = 0;
412 int prev_op;
413 #endif
414 int op;
415 /* Lisp_Object v1, v2; */
416 Lisp_Object *vectorp;
417 #ifdef BYTE_CODE_SAFE
418 int const_length = XVECTOR (vector)->size;
419 Lisp_Object *stacke;
420 #endif
421 int bytestr_length;
422 struct byte_stack stack;
423 Lisp_Object *top;
424 Lisp_Object result;
425
426 #if 0 /* CHECK_FRAME_FONT */
427 {
428 struct frame *f = SELECTED_FRAME ();
429 if (FRAME_X_P (f)
430 && FRAME_FONT (f)->direction != 0
431 && FRAME_FONT (f)->direction != 1)
432 abort ();
433 }
434 #endif
435
436 CHECK_STRING (bytestr);
437 CHECK_VECTOR (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 if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
509 || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
510 EQ (v2, Qunbound)))
511 {
512 BEFORE_POTENTIAL_GC ();
513 v2 = Fsymbol_value (v1);
514 AFTER_POTENTIAL_GC ();
515 }
516 }
517 else
518 {
519 BEFORE_POTENTIAL_GC ();
520 v2 = Fsymbol_value (v1);
521 AFTER_POTENTIAL_GC ();
522 }
523 PUSH (v2);
524 break;
525 }
526
527 case Bgotoifnil:
528 {
529 Lisp_Object v1;
530 MAYBE_GC ();
531 op = FETCH2;
532 v1 = POP;
533 if (NILP (v1))
534 {
535 BYTE_CODE_QUIT;
536 CHECK_RANGE (op);
537 stack.pc = stack.byte_string_start + op;
538 }
539 break;
540 }
541
542 case Bcar:
543 {
544 Lisp_Object v1;
545 v1 = TOP;
546 TOP = CAR (v1);
547 break;
548 }
549
550 case Beq:
551 {
552 Lisp_Object v1;
553 v1 = POP;
554 TOP = EQ (v1, TOP) ? Qt : Qnil;
555 break;
556 }
557
558 case Bmemq:
559 {
560 Lisp_Object v1;
561 BEFORE_POTENTIAL_GC ();
562 v1 = POP;
563 TOP = Fmemq (TOP, v1);
564 AFTER_POTENTIAL_GC ();
565 break;
566 }
567
568 case Bcdr:
569 {
570 Lisp_Object v1;
571 v1 = TOP;
572 TOP = CDR (v1);
573 break;
574 }
575
576 case Bvarset:
577 case Bvarset+1:
578 case Bvarset+2:
579 case Bvarset+3:
580 case Bvarset+4:
581 case Bvarset+5:
582 op -= Bvarset;
583 goto varset;
584
585 case Bvarset+7:
586 op = FETCH2;
587 goto varset;
588
589 case Bvarset+6:
590 op = FETCH;
591 varset:
592 {
593 Lisp_Object sym, val;
594
595 sym = vectorp[op];
596 val = TOP;
597
598 /* Inline the most common case. */
599 if (SYMBOLP (sym)
600 && !EQ (val, Qunbound)
601 && !XSYMBOL (sym)->redirect
602 && !SYMBOL_CONSTANT_P (sym))
603 XSYMBOL (sym)->val.value = val;
604 else
605 {
606 BEFORE_POTENTIAL_GC ();
607 set_internal (sym, val, Qnil, 0);
608 AFTER_POTENTIAL_GC ();
609 }
610 }
611 (void) 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 can signal and thus GC. */
641 BEFORE_POTENTIAL_GC ();
642 specbind (vectorp[op], POP);
643 AFTER_POTENTIAL_GC ();
644 break;
645
646 case Bcall+6:
647 op = FETCH;
648 goto docall;
649
650 case Bcall+7:
651 op = FETCH2;
652 goto docall;
653
654 case Bcall:
655 case Bcall+1:
656 case Bcall+2:
657 case Bcall+3:
658 case Bcall+4:
659 case Bcall+5:
660 op -= Bcall;
661 docall:
662 {
663 BEFORE_POTENTIAL_GC ();
664 DISCARD (op);
665 #ifdef BYTE_CODE_METER
666 if (byte_metering_on && SYMBOLP (TOP))
667 {
668 Lisp_Object v1, v2;
669
670 v1 = TOP;
671 v2 = Fget (v1, Qbyte_code_meter);
672 if (INTEGERP (v2)
673 && XINT (v2) < MOST_POSITIVE_FIXNUM)
674 {
675 XSETINT (v2, XINT (v2) + 1);
676 Fput (v1, Qbyte_code_meter, v2);
677 }
678 }
679 #endif
680 TOP = Ffuncall (op + 1, &TOP);
681 AFTER_POTENTIAL_GC ();
682 break;
683 }
684
685 case Bunbind+6:
686 op = FETCH;
687 goto dounbind;
688
689 case Bunbind+7:
690 op = FETCH2;
691 goto dounbind;
692
693 case Bunbind:
694 case Bunbind+1:
695 case Bunbind+2:
696 case Bunbind+3:
697 case Bunbind+4:
698 case Bunbind+5:
699 op -= Bunbind;
700 dounbind:
701 BEFORE_POTENTIAL_GC ();
702 unbind_to (SPECPDL_INDEX () - op, Qnil);
703 AFTER_POTENTIAL_GC ();
704 break;
705
706 case Bunbind_all:
707 /* To unbind back to the beginning of this frame. Not used yet,
708 but will be needed for tail-recursion elimination. */
709 BEFORE_POTENTIAL_GC ();
710 unbind_to (count, Qnil);
711 AFTER_POTENTIAL_GC ();
712 break;
713
714 case Bgoto:
715 MAYBE_GC ();
716 BYTE_CODE_QUIT;
717 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
718 CHECK_RANGE (op);
719 stack.pc = stack.byte_string_start + op;
720 break;
721
722 case Bgotoifnonnil:
723 {
724 Lisp_Object v1;
725 MAYBE_GC ();
726 op = FETCH2;
727 v1 = POP;
728 if (!NILP (v1))
729 {
730 BYTE_CODE_QUIT;
731 CHECK_RANGE (op);
732 stack.pc = stack.byte_string_start + op;
733 }
734 break;
735 }
736
737 case Bgotoifnilelsepop:
738 MAYBE_GC ();
739 op = FETCH2;
740 if (NILP (TOP))
741 {
742 BYTE_CODE_QUIT;
743 CHECK_RANGE (op);
744 stack.pc = stack.byte_string_start + op;
745 }
746 else DISCARD (1);
747 break;
748
749 case Bgotoifnonnilelsepop:
750 MAYBE_GC ();
751 op = FETCH2;
752 if (!NILP (TOP))
753 {
754 BYTE_CODE_QUIT;
755 CHECK_RANGE (op);
756 stack.pc = stack.byte_string_start + op;
757 }
758 else DISCARD (1);
759 break;
760
761 case BRgoto:
762 MAYBE_GC ();
763 BYTE_CODE_QUIT;
764 stack.pc += (int) *stack.pc - 127;
765 break;
766
767 case BRgotoifnil:
768 {
769 Lisp_Object v1;
770 MAYBE_GC ();
771 v1 = POP;
772 if (NILP (v1))
773 {
774 BYTE_CODE_QUIT;
775 stack.pc += (int) *stack.pc - 128;
776 }
777 stack.pc++;
778 break;
779 }
780
781 case BRgotoifnonnil:
782 {
783 Lisp_Object v1;
784 MAYBE_GC ();
785 v1 = POP;
786 if (!NILP (v1))
787 {
788 BYTE_CODE_QUIT;
789 stack.pc += (int) *stack.pc - 128;
790 }
791 stack.pc++;
792 break;
793 }
794
795 case BRgotoifnilelsepop:
796 MAYBE_GC ();
797 op = *stack.pc++;
798 if (NILP (TOP))
799 {
800 BYTE_CODE_QUIT;
801 stack.pc += op - 128;
802 }
803 else DISCARD (1);
804 break;
805
806 case BRgotoifnonnilelsepop:
807 MAYBE_GC ();
808 op = *stack.pc++;
809 if (!NILP (TOP))
810 {
811 BYTE_CODE_QUIT;
812 stack.pc += op - 128;
813 }
814 else DISCARD (1);
815 break;
816
817 case Breturn:
818 result = POP;
819 goto exit;
820
821 case Bdiscard:
822 DISCARD (1);
823 break;
824
825 case Bconstant2:
826 PUSH (vectorp[FETCH2]);
827 break;
828
829 case Bsave_excursion:
830 record_unwind_protect (save_excursion_restore,
831 save_excursion_save ());
832 break;
833
834 case Bsave_current_buffer:
835 case Bsave_current_buffer_1:
836 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
837 break;
838
839 case Bsave_window_excursion:
840 BEFORE_POTENTIAL_GC ();
841 TOP = Fsave_window_excursion (TOP);
842 AFTER_POTENTIAL_GC ();
843 break;
844
845 case Bsave_restriction:
846 record_unwind_protect (save_restriction_restore,
847 save_restriction_save ());
848 break;
849
850 case Bcatch:
851 {
852 Lisp_Object v1;
853 BEFORE_POTENTIAL_GC ();
854 v1 = POP;
855 TOP = internal_catch (TOP, Feval, v1);
856 AFTER_POTENTIAL_GC ();
857 break;
858 }
859
860 case Bunwind_protect:
861 record_unwind_protect (Fprogn, POP);
862 break;
863
864 case Bcondition_case:
865 {
866 Lisp_Object handlers, body;
867 handlers = POP;
868 body = POP;
869 BEFORE_POTENTIAL_GC ();
870 TOP = internal_lisp_condition_case (TOP, body, handlers);
871 AFTER_POTENTIAL_GC ();
872 break;
873 }
874
875 case Btemp_output_buffer_setup:
876 BEFORE_POTENTIAL_GC ();
877 CHECK_STRING (TOP);
878 temp_output_buffer_setup (SDATA (TOP));
879 AFTER_POTENTIAL_GC ();
880 TOP = Vstandard_output;
881 break;
882
883 case Btemp_output_buffer_show:
884 {
885 Lisp_Object v1;
886 BEFORE_POTENTIAL_GC ();
887 v1 = POP;
888 temp_output_buffer_show (TOP);
889 TOP = v1;
890 /* pop binding of standard-output */
891 unbind_to (SPECPDL_INDEX () - 1, Qnil);
892 AFTER_POTENTIAL_GC ();
893 break;
894 }
895
896 case Bnth:
897 {
898 Lisp_Object v1, v2;
899 BEFORE_POTENTIAL_GC ();
900 v1 = POP;
901 v2 = TOP;
902 CHECK_NUMBER (v2);
903 AFTER_POTENTIAL_GC ();
904 op = XINT (v2);
905 immediate_quit = 1;
906 while (--op >= 0 && CONSP (v1))
907 v1 = XCDR (v1);
908 immediate_quit = 0;
909 TOP = CAR (v1);
910 break;
911 }
912
913 case Bsymbolp:
914 TOP = SYMBOLP (TOP) ? Qt : Qnil;
915 break;
916
917 case Bconsp:
918 TOP = CONSP (TOP) ? Qt : Qnil;
919 break;
920
921 case Bstringp:
922 TOP = STRINGP (TOP) ? Qt : Qnil;
923 break;
924
925 case Blistp:
926 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
927 break;
928
929 case Bnot:
930 TOP = NILP (TOP) ? Qt : Qnil;
931 break;
932
933 case Bcons:
934 {
935 Lisp_Object v1;
936 v1 = POP;
937 TOP = Fcons (TOP, v1);
938 break;
939 }
940
941 case Blist1:
942 TOP = Fcons (TOP, Qnil);
943 break;
944
945 case Blist2:
946 {
947 Lisp_Object v1;
948 v1 = POP;
949 TOP = Fcons (TOP, Fcons (v1, Qnil));
950 break;
951 }
952
953 case Blist3:
954 DISCARD (2);
955 TOP = Flist (3, &TOP);
956 break;
957
958 case Blist4:
959 DISCARD (3);
960 TOP = Flist (4, &TOP);
961 break;
962
963 case BlistN:
964 op = FETCH;
965 DISCARD (op - 1);
966 TOP = Flist (op, &TOP);
967 break;
968
969 case Blength:
970 BEFORE_POTENTIAL_GC ();
971 TOP = Flength (TOP);
972 AFTER_POTENTIAL_GC ();
973 break;
974
975 case Baref:
976 {
977 Lisp_Object v1;
978 BEFORE_POTENTIAL_GC ();
979 v1 = POP;
980 TOP = Faref (TOP, v1);
981 AFTER_POTENTIAL_GC ();
982 break;
983 }
984
985 case Baset:
986 {
987 Lisp_Object v1, v2;
988 BEFORE_POTENTIAL_GC ();
989 v2 = POP; v1 = POP;
990 TOP = Faset (TOP, v1, v2);
991 AFTER_POTENTIAL_GC ();
992 break;
993 }
994
995 case Bsymbol_value:
996 BEFORE_POTENTIAL_GC ();
997 TOP = Fsymbol_value (TOP);
998 AFTER_POTENTIAL_GC ();
999 break;
1000
1001 case Bsymbol_function:
1002 BEFORE_POTENTIAL_GC ();
1003 TOP = Fsymbol_function (TOP);
1004 AFTER_POTENTIAL_GC ();
1005 break;
1006
1007 case Bset:
1008 {
1009 Lisp_Object v1;
1010 BEFORE_POTENTIAL_GC ();
1011 v1 = POP;
1012 TOP = Fset (TOP, v1);
1013 AFTER_POTENTIAL_GC ();
1014 break;
1015 }
1016
1017 case Bfset:
1018 {
1019 Lisp_Object v1;
1020 BEFORE_POTENTIAL_GC ();
1021 v1 = POP;
1022 TOP = Ffset (TOP, v1);
1023 AFTER_POTENTIAL_GC ();
1024 break;
1025 }
1026
1027 case Bget:
1028 {
1029 Lisp_Object v1;
1030 BEFORE_POTENTIAL_GC ();
1031 v1 = POP;
1032 TOP = Fget (TOP, v1);
1033 AFTER_POTENTIAL_GC ();
1034 break;
1035 }
1036
1037 case Bsubstring:
1038 {
1039 Lisp_Object v1, v2;
1040 BEFORE_POTENTIAL_GC ();
1041 v2 = POP; v1 = POP;
1042 TOP = Fsubstring (TOP, v1, v2);
1043 AFTER_POTENTIAL_GC ();
1044 break;
1045 }
1046
1047 case Bconcat2:
1048 BEFORE_POTENTIAL_GC ();
1049 DISCARD (1);
1050 TOP = Fconcat (2, &TOP);
1051 AFTER_POTENTIAL_GC ();
1052 break;
1053
1054 case Bconcat3:
1055 BEFORE_POTENTIAL_GC ();
1056 DISCARD (2);
1057 TOP = Fconcat (3, &TOP);
1058 AFTER_POTENTIAL_GC ();
1059 break;
1060
1061 case Bconcat4:
1062 BEFORE_POTENTIAL_GC ();
1063 DISCARD (3);
1064 TOP = Fconcat (4, &TOP);
1065 AFTER_POTENTIAL_GC ();
1066 break;
1067
1068 case BconcatN:
1069 op = FETCH;
1070 BEFORE_POTENTIAL_GC ();
1071 DISCARD (op - 1);
1072 TOP = Fconcat (op, &TOP);
1073 AFTER_POTENTIAL_GC ();
1074 break;
1075
1076 case Bsub1:
1077 {
1078 Lisp_Object v1;
1079 v1 = TOP;
1080 if (INTEGERP (v1))
1081 {
1082 XSETINT (v1, XINT (v1) - 1);
1083 TOP = v1;
1084 }
1085 else
1086 {
1087 BEFORE_POTENTIAL_GC ();
1088 TOP = Fsub1 (v1);
1089 AFTER_POTENTIAL_GC ();
1090 }
1091 break;
1092 }
1093
1094 case Badd1:
1095 {
1096 Lisp_Object v1;
1097 v1 = TOP;
1098 if (INTEGERP (v1))
1099 {
1100 XSETINT (v1, XINT (v1) + 1);
1101 TOP = v1;
1102 }
1103 else
1104 {
1105 BEFORE_POTENTIAL_GC ();
1106 TOP = Fadd1 (v1);
1107 AFTER_POTENTIAL_GC ();
1108 }
1109 break;
1110 }
1111
1112 case Beqlsign:
1113 {
1114 Lisp_Object v1, v2;
1115 BEFORE_POTENTIAL_GC ();
1116 v2 = POP; v1 = TOP;
1117 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1118 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1119 AFTER_POTENTIAL_GC ();
1120 if (FLOATP (v1) || FLOATP (v2))
1121 {
1122 double f1, f2;
1123
1124 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
1125 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1126 TOP = (f1 == f2 ? Qt : Qnil);
1127 }
1128 else
1129 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
1130 break;
1131 }
1132
1133 case Bgtr:
1134 {
1135 Lisp_Object v1;
1136 BEFORE_POTENTIAL_GC ();
1137 v1 = POP;
1138 TOP = Fgtr (TOP, v1);
1139 AFTER_POTENTIAL_GC ();
1140 break;
1141 }
1142
1143 case Blss:
1144 {
1145 Lisp_Object v1;
1146 BEFORE_POTENTIAL_GC ();
1147 v1 = POP;
1148 TOP = Flss (TOP, v1);
1149 AFTER_POTENTIAL_GC ();
1150 break;
1151 }
1152
1153 case Bleq:
1154 {
1155 Lisp_Object v1;
1156 BEFORE_POTENTIAL_GC ();
1157 v1 = POP;
1158 TOP = Fleq (TOP, v1);
1159 AFTER_POTENTIAL_GC ();
1160 break;
1161 }
1162
1163 case Bgeq:
1164 {
1165 Lisp_Object v1;
1166 BEFORE_POTENTIAL_GC ();
1167 v1 = POP;
1168 TOP = Fgeq (TOP, v1);
1169 AFTER_POTENTIAL_GC ();
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 BEFORE_POTENTIAL_GC ();
1317 XSETFASTINT (v1, (int) current_column ()); /* iftc */
1318 AFTER_POTENTIAL_GC ();
1319 PUSH (v1);
1320 break;
1321 }
1322
1323 case Bindent_to:
1324 BEFORE_POTENTIAL_GC ();
1325 TOP = Findent_to (TOP, Qnil);
1326 AFTER_POTENTIAL_GC ();
1327 break;
1328
1329 case Beolp:
1330 PUSH (Feolp ());
1331 break;
1332
1333 case Beobp:
1334 PUSH (Feobp ());
1335 break;
1336
1337 case Bbolp:
1338 PUSH (Fbolp ());
1339 break;
1340
1341 case Bbobp:
1342 PUSH (Fbobp ());
1343 break;
1344
1345 case Bcurrent_buffer:
1346 PUSH (Fcurrent_buffer ());
1347 break;
1348
1349 case Bset_buffer:
1350 BEFORE_POTENTIAL_GC ();
1351 TOP = Fset_buffer (TOP);
1352 AFTER_POTENTIAL_GC ();
1353 break;
1354
1355 case Binteractive_p:
1356 PUSH (Finteractive_p ());
1357 break;
1358
1359 case Bforward_char:
1360 BEFORE_POTENTIAL_GC ();
1361 TOP = Fforward_char (TOP);
1362 AFTER_POTENTIAL_GC ();
1363 break;
1364
1365 case Bforward_word:
1366 BEFORE_POTENTIAL_GC ();
1367 TOP = Fforward_word (TOP);
1368 AFTER_POTENTIAL_GC ();
1369 break;
1370
1371 case Bskip_chars_forward:
1372 {
1373 Lisp_Object v1;
1374 BEFORE_POTENTIAL_GC ();
1375 v1 = POP;
1376 TOP = Fskip_chars_forward (TOP, v1);
1377 AFTER_POTENTIAL_GC ();
1378 break;
1379 }
1380
1381 case Bskip_chars_backward:
1382 {
1383 Lisp_Object v1;
1384 BEFORE_POTENTIAL_GC ();
1385 v1 = POP;
1386 TOP = Fskip_chars_backward (TOP, v1);
1387 AFTER_POTENTIAL_GC ();
1388 break;
1389 }
1390
1391 case Bforward_line:
1392 BEFORE_POTENTIAL_GC ();
1393 TOP = Fforward_line (TOP);
1394 AFTER_POTENTIAL_GC ();
1395 break;
1396
1397 case Bchar_syntax:
1398 {
1399 int c;
1400
1401 BEFORE_POTENTIAL_GC ();
1402 CHECK_CHARACTER (TOP);
1403 AFTER_POTENTIAL_GC ();
1404 c = XFASTINT (TOP);
1405 if (NILP (current_buffer->enable_multibyte_characters))
1406 MAKE_CHAR_MULTIBYTE (c);
1407 XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
1408 }
1409 break;
1410
1411 case Bbuffer_substring:
1412 {
1413 Lisp_Object v1;
1414 BEFORE_POTENTIAL_GC ();
1415 v1 = POP;
1416 TOP = Fbuffer_substring (TOP, v1);
1417 AFTER_POTENTIAL_GC ();
1418 break;
1419 }
1420
1421 case Bdelete_region:
1422 {
1423 Lisp_Object v1;
1424 BEFORE_POTENTIAL_GC ();
1425 v1 = POP;
1426 TOP = Fdelete_region (TOP, v1);
1427 AFTER_POTENTIAL_GC ();
1428 break;
1429 }
1430
1431 case Bnarrow_to_region:
1432 {
1433 Lisp_Object v1;
1434 BEFORE_POTENTIAL_GC ();
1435 v1 = POP;
1436 TOP = Fnarrow_to_region (TOP, v1);
1437 AFTER_POTENTIAL_GC ();
1438 break;
1439 }
1440
1441 case Bwiden:
1442 BEFORE_POTENTIAL_GC ();
1443 PUSH (Fwiden ());
1444 AFTER_POTENTIAL_GC ();
1445 break;
1446
1447 case Bend_of_line:
1448 BEFORE_POTENTIAL_GC ();
1449 TOP = Fend_of_line (TOP);
1450 AFTER_POTENTIAL_GC ();
1451 break;
1452
1453 case Bset_marker:
1454 {
1455 Lisp_Object v1, v2;
1456 BEFORE_POTENTIAL_GC ();
1457 v1 = POP;
1458 v2 = POP;
1459 TOP = Fset_marker (TOP, v2, v1);
1460 AFTER_POTENTIAL_GC ();
1461 break;
1462 }
1463
1464 case Bmatch_beginning:
1465 BEFORE_POTENTIAL_GC ();
1466 TOP = Fmatch_beginning (TOP);
1467 AFTER_POTENTIAL_GC ();
1468 break;
1469
1470 case Bmatch_end:
1471 BEFORE_POTENTIAL_GC ();
1472 TOP = Fmatch_end (TOP);
1473 AFTER_POTENTIAL_GC ();
1474 break;
1475
1476 case Bupcase:
1477 BEFORE_POTENTIAL_GC ();
1478 TOP = Fupcase (TOP);
1479 AFTER_POTENTIAL_GC ();
1480 break;
1481
1482 case Bdowncase:
1483 BEFORE_POTENTIAL_GC ();
1484 TOP = Fdowncase (TOP);
1485 AFTER_POTENTIAL_GC ();
1486 break;
1487
1488 case Bstringeqlsign:
1489 {
1490 Lisp_Object v1;
1491 BEFORE_POTENTIAL_GC ();
1492 v1 = POP;
1493 TOP = Fstring_equal (TOP, v1);
1494 AFTER_POTENTIAL_GC ();
1495 break;
1496 }
1497
1498 case Bstringlss:
1499 {
1500 Lisp_Object v1;
1501 BEFORE_POTENTIAL_GC ();
1502 v1 = POP;
1503 TOP = Fstring_lessp (TOP, v1);
1504 AFTER_POTENTIAL_GC ();
1505 break;
1506 }
1507
1508 case Bequal:
1509 {
1510 Lisp_Object v1;
1511 v1 = POP;
1512 TOP = Fequal (TOP, v1);
1513 break;
1514 }
1515
1516 case Bnthcdr:
1517 {
1518 Lisp_Object v1;
1519 BEFORE_POTENTIAL_GC ();
1520 v1 = POP;
1521 TOP = Fnthcdr (TOP, v1);
1522 AFTER_POTENTIAL_GC ();
1523 break;
1524 }
1525
1526 case Belt:
1527 {
1528 Lisp_Object v1, v2;
1529 if (CONSP (TOP))
1530 {
1531 /* Exchange args and then do nth. */
1532 BEFORE_POTENTIAL_GC ();
1533 v2 = POP;
1534 v1 = TOP;
1535 CHECK_NUMBER (v2);
1536 AFTER_POTENTIAL_GC ();
1537 op = XINT (v2);
1538 immediate_quit = 1;
1539 while (--op >= 0 && CONSP (v1))
1540 v1 = XCDR (v1);
1541 immediate_quit = 0;
1542 TOP = CAR (v1);
1543 }
1544 else
1545 {
1546 BEFORE_POTENTIAL_GC ();
1547 v1 = POP;
1548 TOP = Felt (TOP, v1);
1549 AFTER_POTENTIAL_GC ();
1550 }
1551 break;
1552 }
1553
1554 case Bmember:
1555 {
1556 Lisp_Object v1;
1557 BEFORE_POTENTIAL_GC ();
1558 v1 = POP;
1559 TOP = Fmember (TOP, v1);
1560 AFTER_POTENTIAL_GC ();
1561 break;
1562 }
1563
1564 case Bassq:
1565 {
1566 Lisp_Object v1;
1567 BEFORE_POTENTIAL_GC ();
1568 v1 = POP;
1569 TOP = Fassq (TOP, v1);
1570 AFTER_POTENTIAL_GC ();
1571 break;
1572 }
1573
1574 case Bnreverse:
1575 BEFORE_POTENTIAL_GC ();
1576 TOP = Fnreverse (TOP);
1577 AFTER_POTENTIAL_GC ();
1578 break;
1579
1580 case Bsetcar:
1581 {
1582 Lisp_Object v1;
1583 BEFORE_POTENTIAL_GC ();
1584 v1 = POP;
1585 TOP = Fsetcar (TOP, v1);
1586 AFTER_POTENTIAL_GC ();
1587 break;
1588 }
1589
1590 case Bsetcdr:
1591 {
1592 Lisp_Object v1;
1593 BEFORE_POTENTIAL_GC ();
1594 v1 = POP;
1595 TOP = Fsetcdr (TOP, v1);
1596 AFTER_POTENTIAL_GC ();
1597 break;
1598 }
1599
1600 case Bcar_safe:
1601 {
1602 Lisp_Object v1;
1603 v1 = TOP;
1604 TOP = CAR_SAFE (v1);
1605 break;
1606 }
1607
1608 case Bcdr_safe:
1609 {
1610 Lisp_Object v1;
1611 v1 = TOP;
1612 TOP = CDR_SAFE (v1);
1613 break;
1614 }
1615
1616 case Bnconc:
1617 BEFORE_POTENTIAL_GC ();
1618 DISCARD (1);
1619 TOP = Fnconc (2, &TOP);
1620 AFTER_POTENTIAL_GC ();
1621 break;
1622
1623 case Bnumberp:
1624 TOP = (NUMBERP (TOP) ? Qt : Qnil);
1625 break;
1626
1627 case Bintegerp:
1628 TOP = INTEGERP (TOP) ? Qt : Qnil;
1629 break;
1630
1631 #ifdef BYTE_CODE_SAFE
1632 case Bset_mark:
1633 BEFORE_POTENTIAL_GC ();
1634 error ("set-mark is an obsolete bytecode");
1635 AFTER_POTENTIAL_GC ();
1636 break;
1637 case Bscan_buffer:
1638 BEFORE_POTENTIAL_GC ();
1639 error ("scan-buffer is an obsolete bytecode");
1640 AFTER_POTENTIAL_GC ();
1641 break;
1642 #endif
1643
1644 case 0:
1645 abort ();
1646
1647 case 255:
1648 default:
1649 #ifdef BYTE_CODE_SAFE
1650 if (op < Bconstant)
1651 {
1652 abort ();
1653 }
1654 if ((op -= Bconstant) >= const_length)
1655 {
1656 abort ();
1657 }
1658 PUSH (vectorp[op]);
1659 #else
1660 PUSH (vectorp[op - Bconstant]);
1661 #endif
1662 }
1663 }
1664
1665 exit:
1666
1667 byte_stack_list = byte_stack_list->next;
1668
1669 /* Binds and unbinds are supposed to be compiled balanced. */
1670 if (SPECPDL_INDEX () != count)
1671 #ifdef BYTE_CODE_SAFE
1672 error ("binding stack not balanced (serious byte compiler bug)");
1673 #else
1674 abort ();
1675 #endif
1676
1677 return result;
1678 }
1679
1680 void
1681 syms_of_bytecode (void)
1682 {
1683 Qbytecode = intern_c_string ("byte-code");
1684 staticpro (&Qbytecode);
1685
1686 defsubr (&Sbyte_code);
1687
1688 #ifdef BYTE_CODE_METER
1689
1690 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1691 doc: /* A vector of vectors which holds a histogram of byte-code usage.
1692 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
1693 opcode CODE has been executed.
1694 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
1695 indicates how many times the byte opcodes CODE1 and CODE2 have been
1696 executed in succession. */);
1697
1698 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
1699 doc: /* If non-nil, keep profiling information on byte code usage.
1700 The variable byte-code-meter indicates how often each byte opcode is used.
1701 If a symbol has a property named `byte-code-meter' whose value is an
1702 integer, it is incremented each time that symbol's function is called. */);
1703
1704 byte_metering_on = 0;
1705 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1706 Qbyte_code_meter = intern_c_string ("byte-code-meter");
1707 staticpro (&Qbyte_code_meter);
1708 {
1709 int i = 256;
1710 while (i--)
1711 XVECTOR (Vbyte_code_meter)->contents[i] =
1712 Fmake_vector (make_number (256), make_number (0));
1713 }
1714 #endif
1715 }
1716
1717 /* arch-tag: b9803b6f-1ed6-4190-8adf-33fd3a9d10e9
1718 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.