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