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