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