diff options
| author | Stefan Monnier | 2022-09-25 16:15:16 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2022-09-25 16:15:16 -0400 |
| commit | 650c20f1ca4e07591a727e1cfcc74b3363d15985 (patch) | |
| tree | 85d11f6437cde22f410c25e0e5f71a3131ebd07d /src/bytecode.c | |
| parent | 8869332684c2302b5ba1ead4568bbc7ba1c0183e (diff) | |
| parent | 4b85ae6a24380fb67a3315eaec9233f17a872473 (diff) | |
| download | emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.gz emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.zip | |
Merge 'master' into noverlay
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 819 |
1 files changed, 543 insertions, 276 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index 50c7abe2891..c765e1be2bc 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | /* Execution of byte code produced by bytecomp.el. | 1 | /* Execution of byte code produced by bytecomp.el. |
| 2 | Copyright (C) 1985-1988, 1993, 2000-2017 Free Software Foundation, | 2 | Copyright (C) 1985-1988, 1993, 2000-2022 Free Software Foundation, |
| 3 | Inc. | 3 | Inc. |
| 4 | 4 | ||
| 5 | This file is part of GNU Emacs. | 5 | This file is part of GNU Emacs. |
| @@ -21,11 +21,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 21 | 21 | ||
| 22 | #include "lisp.h" | 22 | #include "lisp.h" |
| 23 | #include "blockinput.h" | 23 | #include "blockinput.h" |
| 24 | #include "sysstdio.h" | ||
| 24 | #include "character.h" | 25 | #include "character.h" |
| 25 | #include "buffer.h" | 26 | #include "buffer.h" |
| 26 | #include "keyboard.h" | 27 | #include "keyboard.h" |
| 27 | #include "syntax.h" | 28 | #include "syntax.h" |
| 28 | #include "window.h" | 29 | #include "window.h" |
| 30 | #include "puresize.h" | ||
| 29 | 31 | ||
| 30 | /* Work around GCC bug 54561. */ | 32 | /* Work around GCC bug 54561. */ |
| 31 | #if GNUC_PREREQ (4, 3, 0) | 33 | #if GNUC_PREREQ (4, 3, 0) |
| @@ -46,7 +48,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 46 | indirect threaded, using GCC's computed goto extension. This code, | 48 | indirect threaded, using GCC's computed goto extension. This code, |
| 47 | as currently implemented, is incompatible with BYTE_CODE_SAFE and | 49 | as currently implemented, is incompatible with BYTE_CODE_SAFE and |
| 48 | BYTE_CODE_METER. */ | 50 | BYTE_CODE_METER. */ |
| 49 | #if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \ | 51 | #if (defined __GNUC__ && !defined __STRICT_ANSI__ \ |
| 50 | && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER) | 52 | && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER) |
| 51 | #define BYTE_CODE_THREADED | 53 | #define BYTE_CODE_THREADED |
| 52 | #endif | 54 | #endif |
| @@ -62,14 +64,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 62 | { \ | 64 | { \ |
| 63 | if (byte_metering_on) \ | 65 | if (byte_metering_on) \ |
| 64 | { \ | 66 | { \ |
| 65 | if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \ | 67 | if (XFIXNAT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \ |
| 66 | XSETFASTINT (METER_1 (this_code), \ | 68 | XSETFASTINT (METER_1 (this_code), \ |
| 67 | XFASTINT (METER_1 (this_code)) + 1); \ | 69 | XFIXNAT (METER_1 (this_code)) + 1); \ |
| 68 | if (last_code \ | 70 | if (last_code \ |
| 69 | && (XFASTINT (METER_2 (last_code, this_code)) \ | 71 | && (XFIXNAT (METER_2 (last_code, this_code)) \ |
| 70 | < MOST_POSITIVE_FIXNUM)) \ | 72 | < MOST_POSITIVE_FIXNUM)) \ |
| 71 | XSETFASTINT (METER_2 (last_code, this_code), \ | 73 | XSETFASTINT (METER_2 (last_code, this_code), \ |
| 72 | XFASTINT (METER_2 (last_code, this_code)) + 1); \ | 74 | XFIXNAT (METER_2 (last_code, this_code)) + 1); \ |
| 73 | } \ | 75 | } \ |
| 74 | } | 76 | } |
| 75 | 77 | ||
| @@ -174,8 +176,8 @@ DEFINE (Bmin, 0136) \ | |||
| 174 | DEFINE (Bmult, 0137) \ | 176 | DEFINE (Bmult, 0137) \ |
| 175 | \ | 177 | \ |
| 176 | DEFINE (Bpoint, 0140) \ | 178 | DEFINE (Bpoint, 0140) \ |
| 177 | /* Was Bmark in v17. */ \ | 179 | /* 0141 was Bmark in v17, Bsave_current_buffer in 18-19. */ \ |
| 178 | DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \ | 180 | DEFINE (Bsave_current_buffer_OBSOLETE, 0141) /* Obsolete since 20. */ \ |
| 179 | DEFINE (Bgoto_char, 0142) \ | 181 | DEFINE (Bgoto_char, 0142) \ |
| 180 | DEFINE (Binsert, 0143) \ | 182 | DEFINE (Binsert, 0143) \ |
| 181 | DEFINE (Bpoint_max, 0144) \ | 183 | DEFINE (Bpoint_max, 0144) \ |
| @@ -185,13 +187,15 @@ DEFINE (Bfollowing_char, 0147) \ | |||
| 185 | DEFINE (Bpreceding_char, 0150) \ | 187 | DEFINE (Bpreceding_char, 0150) \ |
| 186 | DEFINE (Bcurrent_column, 0151) \ | 188 | DEFINE (Bcurrent_column, 0151) \ |
| 187 | DEFINE (Bindent_to, 0152) \ | 189 | DEFINE (Bindent_to, 0152) \ |
| 190 | /* 0153 was Bscan_buffer in v17. */ \ | ||
| 188 | DEFINE (Beolp, 0154) \ | 191 | DEFINE (Beolp, 0154) \ |
| 189 | DEFINE (Beobp, 0155) \ | 192 | DEFINE (Beobp, 0155) \ |
| 190 | DEFINE (Bbolp, 0156) \ | 193 | DEFINE (Bbolp, 0156) \ |
| 191 | DEFINE (Bbobp, 0157) \ | 194 | DEFINE (Bbobp, 0157) \ |
| 192 | DEFINE (Bcurrent_buffer, 0160) \ | 195 | DEFINE (Bcurrent_buffer, 0160) \ |
| 193 | DEFINE (Bset_buffer, 0161) \ | 196 | DEFINE (Bset_buffer, 0161) \ |
| 194 | DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ | 197 | DEFINE (Bsave_current_buffer, 0162) \ |
| 198 | /* 0163 was Bset_mark in v17. */ \ | ||
| 195 | DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ | 199 | DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ |
| 196 | \ | 200 | \ |
| 197 | DEFINE (Bforward_char, 0165) \ | 201 | DEFINE (Bforward_char, 0165) \ |
| @@ -219,14 +223,14 @@ DEFINE (Bdup, 0211) \ | |||
| 219 | DEFINE (Bsave_excursion, 0212) \ | 223 | DEFINE (Bsave_excursion, 0212) \ |
| 220 | DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ | 224 | DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ |
| 221 | DEFINE (Bsave_restriction, 0214) \ | 225 | DEFINE (Bsave_restriction, 0214) \ |
| 222 | DEFINE (Bcatch, 0215) \ | 226 | DEFINE (Bcatch, 0215) /* Obsolete since Emacs-25. */ \ |
| 223 | \ | 227 | \ |
| 224 | DEFINE (Bunwind_protect, 0216) \ | 228 | DEFINE (Bunwind_protect, 0216) \ |
| 225 | DEFINE (Bcondition_case, 0217) \ | 229 | DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ |
| 226 | DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ | 230 | DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ |
| 227 | DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ | 231 | DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ |
| 228 | \ | 232 | \ |
| 229 | DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \ | 233 | /* 0222 was Bunbind_all, never used. */ \ |
| 230 | \ | 234 | \ |
| 231 | DEFINE (Bset_marker, 0223) \ | 235 | DEFINE (Bset_marker, 0223) \ |
| 232 | DEFINE (Bmatch_beginning, 0224) \ | 236 | DEFINE (Bmatch_beginning, 0224) \ |
| @@ -252,11 +256,7 @@ DEFINE (Brem, 0246) \ | |||
| 252 | DEFINE (Bnumberp, 0247) \ | 256 | DEFINE (Bnumberp, 0247) \ |
| 253 | DEFINE (Bintegerp, 0250) \ | 257 | DEFINE (Bintegerp, 0250) \ |
| 254 | \ | 258 | \ |
| 255 | DEFINE (BRgoto, 0252) \ | 259 | /* 0252-0256 were relative jumps, apparently never used. */ \ |
| 256 | DEFINE (BRgotoifnil, 0253) \ | ||
| 257 | DEFINE (BRgotoifnonnil, 0254) \ | ||
| 258 | DEFINE (BRgotoifnilelsepop, 0255) \ | ||
| 259 | DEFINE (BRgotoifnonnilelsepop, 0256) \ | ||
| 260 | \ | 260 | \ |
| 261 | DEFINE (BlistN, 0257) \ | 261 | DEFINE (BlistN, 0257) \ |
| 262 | DEFINE (BconcatN, 0260) \ | 262 | DEFINE (BconcatN, 0260) \ |
| @@ -276,11 +276,6 @@ enum byte_code_op | |||
| 276 | #define DEFINE(name, value) name = value, | 276 | #define DEFINE(name, value) name = value, |
| 277 | BYTE_CODES | 277 | BYTE_CODES |
| 278 | #undef DEFINE | 278 | #undef DEFINE |
| 279 | |||
| 280 | #if BYTE_CODE_SAFE | ||
| 281 | Bscan_buffer = 0153, /* No longer generated as of v18. */ | ||
| 282 | Bset_mark = 0163, /* this loser is no longer generated as of v18 */ | ||
| 283 | #endif | ||
| 284 | }; | 279 | }; |
| 285 | 280 | ||
| 286 | /* Fetch the next byte from the bytecode stream. */ | 281 | /* Fetch the next byte from the bytecode stream. */ |
| @@ -290,7 +285,7 @@ enum byte_code_op | |||
| 290 | /* Fetch two bytes from the bytecode stream and make a 16-bit number | 285 | /* Fetch two bytes from the bytecode stream and make a 16-bit number |
| 291 | out of them. */ | 286 | out of them. */ |
| 292 | 287 | ||
| 293 | #define FETCH2 (op = FETCH, op + (FETCH << 8)) | 288 | #define FETCH2 (op = FETCH, op | (FETCH << 8)) |
| 294 | 289 | ||
| 295 | /* Push X onto the execution stack. The expression X should not | 290 | /* Push X onto the execution stack. The expression X should not |
| 296 | contain TOP, to avoid competing side effects. */ | 291 | contain TOP, to avoid competing side effects. */ |
| @@ -318,7 +313,20 @@ the third, MAXDEPTH, the maximum stack depth used in this function. | |||
| 318 | If the third argument is incorrect, Emacs may crash. */) | 313 | If the third argument is incorrect, Emacs may crash. */) |
| 319 | (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) | 314 | (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) |
| 320 | { | 315 | { |
| 321 | return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); | 316 | if (! (STRINGP (bytestr) && VECTORP (vector) && FIXNATP (maxdepth))) |
| 317 | error ("Invalid byte-code"); | ||
| 318 | |||
| 319 | if (STRING_MULTIBYTE (bytestr)) | ||
| 320 | { | ||
| 321 | /* BYTESTR must have been produced by Emacs 20.2 or earlier | ||
| 322 | because it produced a raw 8-bit string for byte-code and now | ||
| 323 | such a byte-code string is loaded as multibyte with raw 8-bit | ||
| 324 | characters converted to multibyte form. Convert them back to | ||
| 325 | the original unibyte form. */ | ||
| 326 | bytestr = Fstring_as_unibyte (bytestr); | ||
| 327 | } | ||
| 328 | Lisp_Object fun = CALLN (Fmake_byte_code, Qnil, bytestr, vector, maxdepth); | ||
| 329 | return exec_byte_code (fun, 0, 0, NULL); | ||
| 322 | } | 330 | } |
| 323 | 331 | ||
| 324 | static void | 332 | static void |
| @@ -327,80 +335,213 @@ bcall0 (Lisp_Object f) | |||
| 327 | Ffuncall (1, &f); | 335 | Ffuncall (1, &f); |
| 328 | } | 336 | } |
| 329 | 337 | ||
| 330 | /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and | 338 | /* The bytecode stack size in bytes. |
| 331 | MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, | 339 | This is a fairly generous amount, but: |
| 332 | emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp | 340 | - if users need more, we could allocate more, or just reserve the address |
| 333 | argument list (including &rest, &optional, etc.), and ARGS, of size | 341 | space and allocate on demand |
| 334 | NARGS, should be a vector of the actual arguments. The arguments in | 342 | - if threads are used more, then it might be a good idea to reduce the |
| 335 | ARGS are pushed on the stack according to ARGS_TEMPLATE before | 343 | per-thread overhead in time and space |
| 336 | executing BYTESTR. */ | 344 | - for maximum flexibility but a small runtime penalty, we could allocate |
| 345 | the stack in smaller chunks as needed | ||
| 346 | */ | ||
| 347 | #define BC_STACK_SIZE (512 * 1024 * sizeof (Lisp_Object)) | ||
| 348 | |||
| 349 | /* Bytecode interpreter stack: | ||
| 350 | |||
| 351 | |--------------| -- | ||
| 352 | |fun | | ^ stack growth | ||
| 353 | |saved_pc | | | direction | ||
| 354 | |saved_top ------- | | ||
| 355 | fp--->|saved_fp ---- | | current frame | ||
| 356 | |--------------| | | | (called from bytecode in this example) | ||
| 357 | | (free) | | | | | ||
| 358 | top-->| ...stack... | | | | | ||
| 359 | : ... : | | | | ||
| 360 | |incoming args | | | | | ||
| 361 | |--------------| | | -- | ||
| 362 | |fun | | | | | ||
| 363 | |saved_pc | | | | | ||
| 364 | |saved_top | | | | | ||
| 365 | |saved_fp |<- | | previous frame | ||
| 366 | |--------------| | | | ||
| 367 | | (free) | | | | ||
| 368 | | ...stack... |<---- | | ||
| 369 | : ... : | | ||
| 370 | |incoming args | | | ||
| 371 | |--------------| -- | ||
| 372 | : : | ||
| 373 | */ | ||
| 374 | |||
| 375 | /* bytecode stack frame header (footer, actually) */ | ||
| 376 | struct bc_frame { | ||
| 377 | struct bc_frame *saved_fp; /* previous frame pointer, | ||
| 378 | NULL if bottommost frame */ | ||
| 379 | |||
| 380 | /* In a frame called directly from C, the following two members are NULL. */ | ||
| 381 | Lisp_Object *saved_top; /* previous stack pointer */ | ||
| 382 | const unsigned char *saved_pc; /* previous program counter */ | ||
| 383 | |||
| 384 | Lisp_Object fun; /* current function object */ | ||
| 385 | |||
| 386 | Lisp_Object next_stack[]; /* data stack of next frame */ | ||
| 387 | }; | ||
| 388 | |||
| 389 | void | ||
| 390 | init_bc_thread (struct bc_thread_state *bc) | ||
| 391 | { | ||
| 392 | bc->stack = xmalloc (BC_STACK_SIZE); | ||
| 393 | bc->stack_end = bc->stack + BC_STACK_SIZE; | ||
| 394 | /* Put a dummy header at the bottom to indicate the first free location. */ | ||
| 395 | bc->fp = (struct bc_frame *)bc->stack; | ||
| 396 | memset (bc->fp, 0, sizeof *bc->fp); | ||
| 397 | } | ||
| 398 | |||
| 399 | void | ||
| 400 | free_bc_thread (struct bc_thread_state *bc) | ||
| 401 | { | ||
| 402 | xfree (bc->stack); | ||
| 403 | } | ||
| 404 | |||
| 405 | void | ||
| 406 | mark_bytecode (struct bc_thread_state *bc) | ||
| 407 | { | ||
| 408 | struct bc_frame *fp = bc->fp; | ||
| 409 | Lisp_Object *top = NULL; /* stack pointer of topmost frame not known */ | ||
| 410 | for (;;) | ||
| 411 | { | ||
| 412 | struct bc_frame *next_fp = fp->saved_fp; | ||
| 413 | /* Only the dummy frame at the bottom has saved_fp = NULL. */ | ||
| 414 | if (!next_fp) | ||
| 415 | break; | ||
| 416 | mark_object (fp->fun); | ||
| 417 | Lisp_Object *frame_base = next_fp->next_stack; | ||
| 418 | if (top) | ||
| 419 | { | ||
| 420 | /* The stack pointer of a frame is known: mark the part of the stack | ||
| 421 | above it conservatively. This includes any outgoing arguments. */ | ||
| 422 | mark_memory (top + 1, fp); | ||
| 423 | /* Mark the rest of the stack precisely. */ | ||
| 424 | mark_objects (frame_base, top + 1 - frame_base); | ||
| 425 | } | ||
| 426 | else | ||
| 427 | { | ||
| 428 | /* The stack pointer is unknown -- mark everything conservatively. */ | ||
| 429 | mark_memory (frame_base, fp); | ||
| 430 | } | ||
| 431 | top = fp->saved_top; | ||
| 432 | fp = next_fp; | ||
| 433 | } | ||
| 434 | } | ||
| 435 | |||
| 436 | DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, | ||
| 437 | 0, 0, 0, | ||
| 438 | doc: /* internal */) | ||
| 439 | (void) | ||
| 440 | { | ||
| 441 | struct bc_thread_state *bc = ¤t_thread->bc; | ||
| 442 | int nframes = 0; | ||
| 443 | int nruns = 0; | ||
| 444 | for (struct bc_frame *fp = bc->fp; fp; fp = fp->saved_fp) | ||
| 445 | { | ||
| 446 | nframes++; | ||
| 447 | if (fp->saved_top == NULL) | ||
| 448 | nruns++; | ||
| 449 | } | ||
| 450 | fprintf (stderr, "%d stack frames, %d runs\n", nframes, nruns); | ||
| 451 | return Qnil; | ||
| 452 | } | ||
| 453 | |||
| 454 | /* Whether a stack pointer is valid in the current frame. */ | ||
| 455 | static bool | ||
| 456 | valid_sp (struct bc_thread_state *bc, Lisp_Object *sp) | ||
| 457 | { | ||
| 458 | struct bc_frame *fp = bc->fp; | ||
| 459 | return sp < (Lisp_Object *)fp && sp + 1 >= fp->saved_fp->next_stack; | ||
| 460 | } | ||
| 461 | |||
| 462 | /* Execute the byte-code in FUN. ARGS_TEMPLATE is the function arity | ||
| 463 | encoded as an integer (the one in FUN is ignored), and ARGS, of | ||
| 464 | size NARGS, should be a vector of the actual arguments. The | ||
| 465 | arguments in ARGS are pushed on the stack according to | ||
| 466 | ARGS_TEMPLATE before executing FUN. */ | ||
| 337 | 467 | ||
| 338 | Lisp_Object | 468 | Lisp_Object |
| 339 | exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | 469 | exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, |
| 340 | Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args) | 470 | ptrdiff_t nargs, Lisp_Object *args) |
| 341 | { | 471 | { |
| 342 | #ifdef BYTE_CODE_METER | 472 | #ifdef BYTE_CODE_METER |
| 343 | int volatile this_op = 0; | 473 | int volatile this_op = 0; |
| 344 | #endif | 474 | #endif |
| 475 | unsigned char quitcounter = 1; | ||
| 476 | struct bc_thread_state *bc = ¤t_thread->bc; | ||
| 345 | 477 | ||
| 346 | CHECK_STRING (bytestr); | 478 | /* Values used for the first stack record when called from C. */ |
| 347 | CHECK_VECTOR (vector); | 479 | Lisp_Object *top = NULL; |
| 348 | CHECK_NATNUM (maxdepth); | 480 | unsigned char const *pc = NULL; |
| 349 | 481 | ||
| 350 | ptrdiff_t const_length = ASIZE (vector); | 482 | Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); |
| 351 | 483 | ||
| 352 | if (STRING_MULTIBYTE (bytestr)) | 484 | setup_frame: ; |
| 353 | /* BYTESTR must have been produced by Emacs 20.2 or the earlier | 485 | eassert (!STRING_MULTIBYTE (bytestr)); |
| 354 | because they produced a raw 8-bit string for byte-code and now | 486 | eassert (string_immovable_p (bytestr)); |
| 355 | such a byte-code string is loaded as multibyte while raw 8-bit | 487 | /* FIXME: in debug mode (!NDEBUG, BYTE_CODE_SAFE or enabled checking), |
| 356 | characters converted to multibyte form. Thus, now we must | 488 | save the specpdl index on function entry and check that it is the same |
| 357 | convert them back to the originally intended unibyte form. */ | 489 | when returning, to detect unwind imbalances. This would require adding |
| 358 | bytestr = Fstring_as_unibyte (bytestr); | 490 | a field to the frame header. */ |
| 359 | 491 | ||
| 360 | ptrdiff_t bytestr_length = SBYTES (bytestr); | 492 | Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); |
| 493 | Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH); | ||
| 494 | ptrdiff_t const_length = ASIZE (vector); | ||
| 495 | ptrdiff_t bytestr_length = SCHARS (bytestr); | ||
| 361 | Lisp_Object *vectorp = XVECTOR (vector)->contents; | 496 | Lisp_Object *vectorp = XVECTOR (vector)->contents; |
| 362 | 497 | ||
| 363 | unsigned char quitcounter = 1; | 498 | EMACS_INT max_stack = XFIXNAT (maxdepth); |
| 364 | EMACS_INT stack_items = XFASTINT (maxdepth) + 1; | 499 | Lisp_Object *frame_base = bc->fp->next_stack; |
| 365 | USE_SAFE_ALLOCA; | 500 | struct bc_frame *fp = (struct bc_frame *)(frame_base + max_stack); |
| 366 | Lisp_Object *stack_base; | 501 | |
| 367 | SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length); | 502 | if ((char *)fp->next_stack > bc->stack_end) |
| 368 | Lisp_Object *stack_lim = stack_base + stack_items; | 503 | error ("Bytecode stack overflow"); |
| 369 | Lisp_Object *top = stack_base; | 504 | |
| 370 | memcpy (stack_lim, SDATA (bytestr), bytestr_length); | 505 | /* Save the function object so that the bytecode and vector are |
| 371 | void *void_stack_lim = stack_lim; | 506 | held from removal by the GC. */ |
| 372 | unsigned char const *bytestr_data = void_stack_lim; | 507 | fp->fun = fun; |
| 373 | unsigned char const *pc = bytestr_data; | 508 | /* Save previous stack pointer and pc in the new frame. If we came |
| 374 | ptrdiff_t count = SPECPDL_INDEX (); | 509 | directly from outside, these will be NULL. */ |
| 375 | 510 | fp->saved_top = top; | |
| 376 | if (!NILP (args_template)) | 511 | fp->saved_pc = pc; |
| 377 | { | 512 | fp->saved_fp = bc->fp; |
| 378 | eassert (INTEGERP (args_template)); | 513 | bc->fp = fp; |
| 379 | ptrdiff_t at = XINT (args_template); | 514 | |
| 380 | bool rest = (at & 128) != 0; | 515 | top = frame_base - 1; |
| 381 | int mandatory = at & 127; | 516 | unsigned char const *bytestr_data = SDATA (bytestr); |
| 382 | ptrdiff_t nonrest = at >> 8; | 517 | pc = bytestr_data; |
| 383 | ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest; | 518 | |
| 384 | if (! (mandatory <= nargs && nargs <= maxargs)) | 519 | /* ARGS_TEMPLATE is composed of bit fields: |
| 385 | Fsignal (Qwrong_number_of_arguments, | 520 | bits 0..6 minimum number of arguments |
| 386 | list2 (Fcons (make_number (mandatory), make_number (nonrest)), | 521 | bits 7 1 iff &rest argument present |
| 387 | make_number (nargs))); | 522 | bits 8..14 maximum number of arguments */ |
| 388 | ptrdiff_t pushedargs = min (nonrest, nargs); | 523 | bool rest = (args_template & 128) != 0; |
| 389 | for (ptrdiff_t i = 0; i < pushedargs; i++, args++) | 524 | int mandatory = args_template & 127; |
| 390 | PUSH (*args); | 525 | ptrdiff_t nonrest = args_template >> 8; |
| 391 | if (nonrest < nargs) | 526 | if (! (mandatory <= nargs && (rest || nargs <= nonrest))) |
| 392 | PUSH (Flist (nargs - nonrest, args)); | 527 | Fsignal (Qwrong_number_of_arguments, |
| 393 | else | 528 | list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), |
| 394 | for (ptrdiff_t i = nargs - rest; i < nonrest; i++) | 529 | make_fixnum (nargs))); |
| 395 | PUSH (Qnil); | 530 | ptrdiff_t pushedargs = min (nonrest, nargs); |
| 396 | } | 531 | for (ptrdiff_t i = 0; i < pushedargs; i++, args++) |
| 532 | PUSH (*args); | ||
| 533 | if (nonrest < nargs) | ||
| 534 | PUSH (Flist (nargs - nonrest, args)); | ||
| 535 | else | ||
| 536 | for (ptrdiff_t i = nargs - rest; i < nonrest; i++) | ||
| 537 | PUSH (Qnil); | ||
| 397 | 538 | ||
| 398 | while (true) | 539 | while (true) |
| 399 | { | 540 | { |
| 400 | int op; | 541 | int op; |
| 401 | enum handlertype type; | 542 | enum handlertype type; |
| 402 | 543 | ||
| 403 | if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim)) | 544 | if (BYTE_CODE_SAFE && !valid_sp (bc, top)) |
| 404 | emacs_abort (); | 545 | emacs_abort (); |
| 405 | 546 | ||
| 406 | #ifdef BYTE_CODE_METER | 547 | #ifdef BYTE_CODE_METER |
| @@ -448,17 +589,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 448 | 589 | ||
| 449 | #ifdef BYTE_CODE_THREADED | 590 | #ifdef BYTE_CODE_THREADED |
| 450 | 591 | ||
| 451 | /* A convenience define that saves us a lot of typing and makes | ||
| 452 | the table clearer. */ | ||
| 453 | #define LABEL(OP) [OP] = &&insn_ ## OP | ||
| 454 | |||
| 455 | /* This is the dispatch table for the threaded interpreter. */ | 592 | /* This is the dispatch table for the threaded interpreter. */ |
| 456 | static const void *const targets[256] = | 593 | static const void *const targets[256] = |
| 457 | { | 594 | { |
| 458 | [0 ... (Bconstant - 1)] = &&insn_default, | 595 | [0 ... (Bconstant - 1)] = &&insn_default, |
| 459 | [Bconstant ... 255] = &&insn_Bconstant, | 596 | [Bconstant ... 255] = &&insn_Bconstant, |
| 460 | 597 | ||
| 461 | #define DEFINE(name, value) LABEL (name) , | 598 | #define DEFINE(name, value) [name] = &&insn_ ## name, |
| 462 | BYTE_CODES | 599 | BYTE_CODES |
| 463 | #undef DEFINE | 600 | #undef DEFINE |
| 464 | }; | 601 | }; |
| @@ -489,8 +626,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 489 | { | 626 | { |
| 490 | Lisp_Object v1 = vectorp[op], v2; | 627 | Lisp_Object v1 = vectorp[op], v2; |
| 491 | if (!SYMBOLP (v1) | 628 | if (!SYMBOLP (v1) |
| 492 | || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL | 629 | || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL |
| 493 | || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) | 630 | || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound))) |
| 494 | v2 = Fsymbol_value (v1); | 631 | v2 = Fsymbol_value (v1); |
| 495 | PUSH (v2); | 632 | PUSH (v2); |
| 496 | NEXT; | 633 | NEXT; |
| @@ -557,8 +694,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 557 | 694 | ||
| 558 | /* Inline the most common case. */ | 695 | /* Inline the most common case. */ |
| 559 | if (SYMBOLP (sym) | 696 | if (SYMBOLP (sym) |
| 560 | && !EQ (val, Qunbound) | 697 | && !BASE_EQ (val, Qunbound) |
| 561 | && !XSYMBOL (sym)->redirect | 698 | && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL |
| 562 | && !SYMBOL_TRAPPED_WRITE_P (sym)) | 699 | && !SYMBOL_TRAPPED_WRITE_P (sym)) |
| 563 | SET_SYMBOL_VAL (XSYMBOL (sym), val); | 700 | SET_SYMBOL_VAL (XSYMBOL (sym), val); |
| 564 | else | 701 | else |
| @@ -618,15 +755,67 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 618 | { | 755 | { |
| 619 | Lisp_Object v1 = TOP; | 756 | Lisp_Object v1 = TOP; |
| 620 | Lisp_Object v2 = Fget (v1, Qbyte_code_meter); | 757 | Lisp_Object v2 = Fget (v1, Qbyte_code_meter); |
| 621 | if (INTEGERP (v2) | 758 | if (FIXNUMP (v2) |
| 622 | && XINT (v2) < MOST_POSITIVE_FIXNUM) | 759 | && XFIXNUM (v2) < MOST_POSITIVE_FIXNUM) |
| 623 | { | 760 | { |
| 624 | XSETINT (v2, XINT (v2) + 1); | 761 | XSETINT (v2, XFIXNUM (v2) + 1); |
| 625 | Fput (v1, Qbyte_code_meter, v2); | 762 | Fput (v1, Qbyte_code_meter, v2); |
| 626 | } | 763 | } |
| 627 | } | 764 | } |
| 628 | #endif | 765 | #endif |
| 629 | TOP = Ffuncall (op + 1, &TOP); | 766 | maybe_quit (); |
| 767 | |||
| 768 | if (++lisp_eval_depth > max_lisp_eval_depth) | ||
| 769 | { | ||
| 770 | if (max_lisp_eval_depth < 100) | ||
| 771 | max_lisp_eval_depth = 100; | ||
| 772 | if (lisp_eval_depth > max_lisp_eval_depth) | ||
| 773 | error ("Lisp nesting exceeds `max-lisp-eval-depth'"); | ||
| 774 | } | ||
| 775 | |||
| 776 | ptrdiff_t call_nargs = op; | ||
| 777 | Lisp_Object call_fun = TOP; | ||
| 778 | Lisp_Object *call_args = &TOP + 1; | ||
| 779 | |||
| 780 | specpdl_ref count1 = record_in_backtrace (call_fun, | ||
| 781 | call_args, call_nargs); | ||
| 782 | maybe_gc (); | ||
| 783 | if (debug_on_next_call) | ||
| 784 | do_debug_on_call (Qlambda, count1); | ||
| 785 | |||
| 786 | Lisp_Object original_fun = call_fun; | ||
| 787 | if (SYMBOLP (call_fun)) | ||
| 788 | call_fun = XSYMBOL (call_fun)->u.s.function; | ||
| 789 | Lisp_Object template; | ||
| 790 | Lisp_Object bytecode; | ||
| 791 | if (COMPILEDP (call_fun) | ||
| 792 | // Lexical binding only. | ||
| 793 | && (template = AREF (call_fun, COMPILED_ARGLIST), | ||
| 794 | FIXNUMP (template)) | ||
| 795 | // No autoloads. | ||
| 796 | && (bytecode = AREF (call_fun, COMPILED_BYTECODE), | ||
| 797 | !CONSP (bytecode))) | ||
| 798 | { | ||
| 799 | fun = call_fun; | ||
| 800 | bytestr = bytecode; | ||
| 801 | args_template = XFIXNUM (template); | ||
| 802 | nargs = call_nargs; | ||
| 803 | args = call_args; | ||
| 804 | goto setup_frame; | ||
| 805 | } | ||
| 806 | |||
| 807 | Lisp_Object val; | ||
| 808 | if (SUBRP (call_fun) && !SUBR_NATIVE_COMPILED_DYNP (call_fun)) | ||
| 809 | val = funcall_subr (XSUBR (call_fun), call_nargs, call_args); | ||
| 810 | else | ||
| 811 | val = funcall_general (original_fun, call_nargs, call_args); | ||
| 812 | |||
| 813 | lisp_eval_depth--; | ||
| 814 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) | ||
| 815 | val = call_debugger (list2 (Qexit, val)); | ||
| 816 | specpdl_ptr--; | ||
| 817 | |||
| 818 | TOP = val; | ||
| 630 | NEXT; | 819 | NEXT; |
| 631 | } | 820 | } |
| 632 | 821 | ||
| @@ -646,20 +835,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 646 | CASE (Bunbind5): | 835 | CASE (Bunbind5): |
| 647 | op -= Bunbind; | 836 | op -= Bunbind; |
| 648 | dounbind: | 837 | dounbind: |
| 649 | unbind_to (SPECPDL_INDEX () - op, Qnil); | 838 | unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -op), Qnil); |
| 650 | NEXT; | ||
| 651 | |||
| 652 | CASE (Bunbind_all): /* Obsolete. Never used. */ | ||
| 653 | /* To unbind back to the beginning of this frame. Not used yet, | ||
| 654 | but will be needed for tail-recursion elimination. */ | ||
| 655 | unbind_to (count, Qnil); | ||
| 656 | NEXT; | 839 | NEXT; |
| 657 | 840 | ||
| 658 | CASE (Bgoto): | 841 | CASE (Bgoto): |
| 659 | op = FETCH2; | 842 | op = FETCH2; |
| 660 | op_branch: | 843 | op_branch: |
| 661 | op -= pc - bytestr_data; | 844 | op -= pc - bytestr_data; |
| 662 | op_relative_branch: | ||
| 663 | if (BYTE_CODE_SAFE | 845 | if (BYTE_CODE_SAFE |
| 664 | && ! (bytestr_data - pc <= op | 846 | && ! (bytestr_data - pc <= op |
| 665 | && op < bytestr_data + bytestr_length - pc)) | 847 | && op < bytestr_data + bytestr_length - pc)) |
| @@ -694,38 +876,41 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 694 | DISCARD (1); | 876 | DISCARD (1); |
| 695 | NEXT; | 877 | NEXT; |
| 696 | 878 | ||
| 697 | CASE (BRgoto): | ||
| 698 | op = FETCH - 128; | ||
| 699 | goto op_relative_branch; | ||
| 700 | |||
| 701 | CASE (BRgotoifnil): | ||
| 702 | op = FETCH - 128; | ||
| 703 | if (NILP (POP)) | ||
| 704 | goto op_relative_branch; | ||
| 705 | NEXT; | ||
| 706 | |||
| 707 | CASE (BRgotoifnonnil): | ||
| 708 | op = FETCH - 128; | ||
| 709 | if (!NILP (POP)) | ||
| 710 | goto op_relative_branch; | ||
| 711 | NEXT; | ||
| 712 | |||
| 713 | CASE (BRgotoifnilelsepop): | ||
| 714 | op = FETCH - 128; | ||
| 715 | if (NILP (TOP)) | ||
| 716 | goto op_relative_branch; | ||
| 717 | DISCARD (1); | ||
| 718 | NEXT; | ||
| 719 | |||
| 720 | CASE (BRgotoifnonnilelsepop): | ||
| 721 | op = FETCH - 128; | ||
| 722 | if (!NILP (TOP)) | ||
| 723 | goto op_relative_branch; | ||
| 724 | DISCARD (1); | ||
| 725 | NEXT; | ||
| 726 | |||
| 727 | CASE (Breturn): | 879 | CASE (Breturn): |
| 728 | goto exit; | 880 | { |
| 881 | Lisp_Object *saved_top = bc->fp->saved_top; | ||
| 882 | if (saved_top) | ||
| 883 | { | ||
| 884 | Lisp_Object val = TOP; | ||
| 885 | |||
| 886 | lisp_eval_depth--; | ||
| 887 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) | ||
| 888 | val = call_debugger (list2 (Qexit, val)); | ||
| 889 | specpdl_ptr--; | ||
| 890 | |||
| 891 | top = saved_top; | ||
| 892 | pc = bc->fp->saved_pc; | ||
| 893 | struct bc_frame *fp = bc->fp->saved_fp; | ||
| 894 | bc->fp = fp; | ||
| 895 | |||
| 896 | Lisp_Object fun = fp->fun; | ||
| 897 | Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); | ||
| 898 | Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); | ||
| 899 | bytestr_data = SDATA (bytestr); | ||
| 900 | vectorp = XVECTOR (vector)->contents; | ||
| 901 | if (BYTE_CODE_SAFE) | ||
| 902 | { | ||
| 903 | /* Only required for checking, not for execution. */ | ||
| 904 | const_length = ASIZE (vector); | ||
| 905 | bytestr_length = SCHARS (bytestr); | ||
| 906 | } | ||
| 907 | |||
| 908 | TOP = val; | ||
| 909 | NEXT; | ||
| 910 | } | ||
| 911 | else | ||
| 912 | goto exit; | ||
| 913 | } | ||
| 729 | 914 | ||
| 730 | CASE (Bdiscard): | 915 | CASE (Bdiscard): |
| 731 | DISCARD (1); | 916 | DISCARD (1); |
| @@ -736,18 +921,17 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 736 | NEXT; | 921 | NEXT; |
| 737 | 922 | ||
| 738 | CASE (Bsave_excursion): | 923 | CASE (Bsave_excursion): |
| 739 | record_unwind_protect (save_excursion_restore, | 924 | record_unwind_protect_excursion (); |
| 740 | save_excursion_save ()); | ||
| 741 | NEXT; | 925 | NEXT; |
| 742 | 926 | ||
| 743 | CASE (Bsave_current_buffer): /* Obsolete since ??. */ | 927 | CASE (Bsave_current_buffer_OBSOLETE): /* Obsolete since 20. */ |
| 744 | CASE (Bsave_current_buffer_1): | 928 | CASE (Bsave_current_buffer): |
| 745 | record_unwind_current_buffer (); | 929 | record_unwind_current_buffer (); |
| 746 | NEXT; | 930 | NEXT; |
| 747 | 931 | ||
| 748 | CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ | 932 | CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ |
| 749 | { | 933 | { |
| 750 | ptrdiff_t count1 = SPECPDL_INDEX (); | 934 | specpdl_ref count1 = SPECPDL_INDEX (); |
| 751 | record_unwind_protect (restore_window_configuration, | 935 | record_unwind_protect (restore_window_configuration, |
| 752 | Fcurrent_window_configuration (Qnil)); | 936 | Fcurrent_window_configuration (Qnil)); |
| 753 | TOP = Fprogn (TOP); | 937 | TOP = Fprogn (TOP); |
| @@ -760,7 +944,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 760 | save_restriction_save ()); | 944 | save_restriction_save ()); |
| 761 | NEXT; | 945 | NEXT; |
| 762 | 946 | ||
| 763 | CASE (Bcatch): /* Obsolete since 24.4. */ | 947 | CASE (Bcatch): /* Obsolete since 25. */ |
| 764 | { | 948 | { |
| 765 | Lisp_Object v1 = POP; | 949 | Lisp_Object v1 = POP; |
| 766 | TOP = internal_catch (TOP, eval_sub, v1); | 950 | TOP = internal_catch (TOP, eval_sub, v1); |
| @@ -781,9 +965,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 781 | if (sys_setjmp (c->jmp)) | 965 | if (sys_setjmp (c->jmp)) |
| 782 | { | 966 | { |
| 783 | struct handler *c = handlerlist; | 967 | struct handler *c = handlerlist; |
| 968 | handlerlist = c->next; | ||
| 784 | top = c->bytecode_top; | 969 | top = c->bytecode_top; |
| 785 | op = c->bytecode_dest; | 970 | op = c->bytecode_dest; |
| 786 | handlerlist = c->next; | 971 | struct bc_frame *fp = bc->fp; |
| 972 | |||
| 973 | Lisp_Object fun = fp->fun; | ||
| 974 | Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); | ||
| 975 | Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); | ||
| 976 | bytestr_data = SDATA (bytestr); | ||
| 977 | vectorp = XVECTOR (vector)->contents; | ||
| 978 | if (BYTE_CODE_SAFE) | ||
| 979 | { | ||
| 980 | /* Only required for checking, not for execution. */ | ||
| 981 | const_length = ASIZE (vector); | ||
| 982 | bytestr_length = SCHARS (bytestr); | ||
| 983 | } | ||
| 984 | pc = bytestr_data; | ||
| 787 | PUSH (c->val); | 985 | PUSH (c->val); |
| 788 | goto op_branch; | 986 | goto op_branch; |
| 789 | } | 987 | } |
| @@ -804,7 +1002,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 804 | NEXT; | 1002 | NEXT; |
| 805 | } | 1003 | } |
| 806 | 1004 | ||
| 807 | CASE (Bcondition_case): /* Obsolete since 24.4. */ | 1005 | CASE (Bcondition_case): /* Obsolete since 25. */ |
| 808 | { | 1006 | { |
| 809 | Lisp_Object handlers = POP, body = POP; | 1007 | Lisp_Object handlers = POP, body = POP; |
| 810 | TOP = internal_lisp_condition_case (TOP, body, handlers); | 1008 | TOP = internal_lisp_condition_case (TOP, body, handlers); |
| @@ -823,20 +1021,21 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 823 | temp_output_buffer_show (TOP); | 1021 | temp_output_buffer_show (TOP); |
| 824 | TOP = v1; | 1022 | TOP = v1; |
| 825 | /* pop binding of standard-output */ | 1023 | /* pop binding of standard-output */ |
| 826 | unbind_to (SPECPDL_INDEX () - 1, Qnil); | 1024 | unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -1), Qnil); |
| 827 | NEXT; | 1025 | NEXT; |
| 828 | } | 1026 | } |
| 829 | 1027 | ||
| 830 | CASE (Bnth): | 1028 | CASE (Bnth): |
| 831 | { | 1029 | { |
| 832 | Lisp_Object v2 = POP, v1 = TOP; | 1030 | Lisp_Object v2 = POP, v1 = TOP; |
| 833 | CHECK_NUMBER (v1); | 1031 | if (RANGED_FIXNUMP (0, v1, SMALL_LIST_LEN_MAX)) |
| 834 | for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) | ||
| 835 | { | 1032 | { |
| 836 | v2 = XCDR (v2); | 1033 | for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) |
| 837 | rarely_quit (n); | 1034 | v2 = XCDR (v2); |
| 1035 | TOP = CAR (v2); | ||
| 838 | } | 1036 | } |
| 839 | TOP = CAR (v2); | 1037 | else |
| 1038 | TOP = Fnth (v1, v2); | ||
| 840 | NEXT; | 1039 | NEXT; |
| 841 | } | 1040 | } |
| 842 | 1041 | ||
| @@ -880,12 +1079,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 880 | 1079 | ||
| 881 | CASE (Blist3): | 1080 | CASE (Blist3): |
| 882 | DISCARD (2); | 1081 | DISCARD (2); |
| 883 | TOP = Flist (3, &TOP); | 1082 | TOP = list3 (TOP, top[1], top[2]); |
| 884 | NEXT; | 1083 | NEXT; |
| 885 | 1084 | ||
| 886 | CASE (Blist4): | 1085 | CASE (Blist4): |
| 887 | DISCARD (3); | 1086 | DISCARD (3); |
| 888 | TOP = Flist (4, &TOP); | 1087 | TOP = list4 (TOP, top[1], top[2], top[3]); |
| 889 | NEXT; | 1088 | NEXT; |
| 890 | 1089 | ||
| 891 | CASE (BlistN): | 1090 | CASE (BlistN): |
| @@ -900,15 +1099,39 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 900 | 1099 | ||
| 901 | CASE (Baref): | 1100 | CASE (Baref): |
| 902 | { | 1101 | { |
| 903 | Lisp_Object v1 = POP; | 1102 | Lisp_Object idxval = POP; |
| 904 | TOP = Faref (TOP, v1); | 1103 | Lisp_Object arrayval = TOP; |
| 1104 | ptrdiff_t size; | ||
| 1105 | ptrdiff_t idx; | ||
| 1106 | if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) | ||
| 1107 | || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) | ||
| 1108 | && FIXNUMP (idxval) | ||
| 1109 | && (idx = XFIXNUM (idxval), | ||
| 1110 | idx >= 0 && idx < size)) | ||
| 1111 | TOP = AREF (arrayval, idx); | ||
| 1112 | else | ||
| 1113 | TOP = Faref (arrayval, idxval); | ||
| 905 | NEXT; | 1114 | NEXT; |
| 906 | } | 1115 | } |
| 907 | 1116 | ||
| 908 | CASE (Baset): | 1117 | CASE (Baset): |
| 909 | { | 1118 | { |
| 910 | Lisp_Object v2 = POP, v1 = POP; | 1119 | Lisp_Object newelt = POP; |
| 911 | TOP = Faset (TOP, v1, v2); | 1120 | Lisp_Object idxval = POP; |
| 1121 | Lisp_Object arrayval = TOP; | ||
| 1122 | ptrdiff_t size; | ||
| 1123 | ptrdiff_t idx; | ||
| 1124 | if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) | ||
| 1125 | || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) | ||
| 1126 | && FIXNUMP (idxval) | ||
| 1127 | && (idx = XFIXNUM (idxval), | ||
| 1128 | idx >= 0 && idx < size)) | ||
| 1129 | { | ||
| 1130 | ASET (arrayval, idx, newelt); | ||
| 1131 | TOP = newelt; | ||
| 1132 | } | ||
| 1133 | else | ||
| 1134 | TOP = Faset (arrayval, idxval, newelt); | ||
| 912 | NEXT; | 1135 | NEXT; |
| 913 | } | 1136 | } |
| 914 | 1137 | ||
| @@ -970,98 +1193,175 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 970 | NEXT; | 1193 | NEXT; |
| 971 | 1194 | ||
| 972 | CASE (Bsub1): | 1195 | CASE (Bsub1): |
| 973 | TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP); | 1196 | TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM |
| 1197 | ? make_fixnum (XFIXNUM (TOP) - 1) | ||
| 1198 | : Fsub1 (TOP)); | ||
| 974 | NEXT; | 1199 | NEXT; |
| 975 | 1200 | ||
| 976 | CASE (Badd1): | 1201 | CASE (Badd1): |
| 977 | TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP); | 1202 | TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_POSITIVE_FIXNUM |
| 1203 | ? make_fixnum (XFIXNUM (TOP) + 1) | ||
| 1204 | : Fadd1 (TOP)); | ||
| 978 | NEXT; | 1205 | NEXT; |
| 979 | 1206 | ||
| 980 | CASE (Beqlsign): | 1207 | CASE (Beqlsign): |
| 981 | { | 1208 | { |
| 982 | Lisp_Object v2 = POP, v1 = TOP; | 1209 | Lisp_Object v2 = POP; |
| 983 | if (FLOATP (v1) || FLOATP (v2)) | 1210 | Lisp_Object v1 = TOP; |
| 984 | TOP = arithcompare (v1, v2, ARITH_EQUAL); | 1211 | if (FIXNUMP (v1) && FIXNUMP (v2)) |
| 1212 | TOP = BASE_EQ (v1, v2) ? Qt : Qnil; | ||
| 985 | else | 1213 | else |
| 986 | { | 1214 | TOP = arithcompare (v1, v2, ARITH_EQUAL); |
| 987 | CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1); | ||
| 988 | CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2); | ||
| 989 | TOP = EQ (v1, v2) ? Qt : Qnil; | ||
| 990 | } | ||
| 991 | NEXT; | 1215 | NEXT; |
| 992 | } | 1216 | } |
| 993 | 1217 | ||
| 994 | CASE (Bgtr): | 1218 | CASE (Bgtr): |
| 995 | { | 1219 | { |
| 996 | Lisp_Object v1 = POP; | 1220 | Lisp_Object v2 = POP; |
| 997 | TOP = arithcompare (TOP, v1, ARITH_GRTR); | 1221 | Lisp_Object v1 = TOP; |
| 1222 | if (FIXNUMP (v1) && FIXNUMP (v2)) | ||
| 1223 | TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil; | ||
| 1224 | else | ||
| 1225 | TOP = arithcompare (v1, v2, ARITH_GRTR); | ||
| 998 | NEXT; | 1226 | NEXT; |
| 999 | } | 1227 | } |
| 1000 | 1228 | ||
| 1001 | CASE (Blss): | 1229 | CASE (Blss): |
| 1002 | { | 1230 | { |
| 1003 | Lisp_Object v1 = POP; | 1231 | Lisp_Object v2 = POP; |
| 1004 | TOP = arithcompare (TOP, v1, ARITH_LESS); | 1232 | Lisp_Object v1 = TOP; |
| 1233 | if (FIXNUMP (v1) && FIXNUMP (v2)) | ||
| 1234 | TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil; | ||
| 1235 | else | ||
| 1236 | TOP = arithcompare (v1, v2, ARITH_LESS); | ||
| 1005 | NEXT; | 1237 | NEXT; |
| 1006 | } | 1238 | } |
| 1007 | 1239 | ||
| 1008 | CASE (Bleq): | 1240 | CASE (Bleq): |
| 1009 | { | 1241 | { |
| 1010 | Lisp_Object v1 = POP; | 1242 | Lisp_Object v2 = POP; |
| 1011 | TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); | 1243 | Lisp_Object v1 = TOP; |
| 1244 | if (FIXNUMP (v1) && FIXNUMP (v2)) | ||
| 1245 | TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil; | ||
| 1246 | else | ||
| 1247 | TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL); | ||
| 1012 | NEXT; | 1248 | NEXT; |
| 1013 | } | 1249 | } |
| 1014 | 1250 | ||
| 1015 | CASE (Bgeq): | 1251 | CASE (Bgeq): |
| 1016 | { | 1252 | { |
| 1017 | Lisp_Object v1 = POP; | 1253 | Lisp_Object v2 = POP; |
| 1018 | TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); | 1254 | Lisp_Object v1 = TOP; |
| 1255 | if (FIXNUMP (v1) && FIXNUMP (v2)) | ||
| 1256 | TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil; | ||
| 1257 | else | ||
| 1258 | TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL); | ||
| 1019 | NEXT; | 1259 | NEXT; |
| 1020 | } | 1260 | } |
| 1021 | 1261 | ||
| 1022 | CASE (Bdiff): | 1262 | CASE (Bdiff): |
| 1023 | DISCARD (1); | 1263 | { |
| 1024 | TOP = Fminus (2, &TOP); | 1264 | Lisp_Object v2 = POP; |
| 1025 | NEXT; | 1265 | Lisp_Object v1 = TOP; |
| 1266 | EMACS_INT res; | ||
| 1267 | if (FIXNUMP (v1) && FIXNUMP (v2) | ||
| 1268 | && (res = XFIXNUM (v1) - XFIXNUM (v2), | ||
| 1269 | !FIXNUM_OVERFLOW_P (res))) | ||
| 1270 | TOP = make_fixnum (res); | ||
| 1271 | else | ||
| 1272 | TOP = Fminus (2, &TOP); | ||
| 1273 | NEXT; | ||
| 1274 | } | ||
| 1026 | 1275 | ||
| 1027 | CASE (Bnegate): | 1276 | CASE (Bnegate): |
| 1028 | TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP); | 1277 | TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM |
| 1278 | ? make_fixnum (- XFIXNUM (TOP)) | ||
| 1279 | : Fminus (1, &TOP)); | ||
| 1029 | NEXT; | 1280 | NEXT; |
| 1030 | 1281 | ||
| 1031 | CASE (Bplus): | 1282 | CASE (Bplus): |
| 1032 | DISCARD (1); | 1283 | { |
| 1033 | TOP = Fplus (2, &TOP); | 1284 | Lisp_Object v2 = POP; |
| 1034 | NEXT; | 1285 | Lisp_Object v1 = TOP; |
| 1286 | EMACS_INT res; | ||
| 1287 | if (FIXNUMP (v1) && FIXNUMP (v2) | ||
| 1288 | && (res = XFIXNUM (v1) + XFIXNUM (v2), | ||
| 1289 | !FIXNUM_OVERFLOW_P (res))) | ||
| 1290 | TOP = make_fixnum (res); | ||
| 1291 | else | ||
| 1292 | TOP = Fplus (2, &TOP); | ||
| 1293 | NEXT; | ||
| 1294 | } | ||
| 1035 | 1295 | ||
| 1036 | CASE (Bmax): | 1296 | CASE (Bmax): |
| 1037 | DISCARD (1); | 1297 | { |
| 1038 | TOP = Fmax (2, &TOP); | 1298 | Lisp_Object v2 = POP; |
| 1039 | NEXT; | 1299 | Lisp_Object v1 = TOP; |
| 1300 | if (FIXNUMP (v1) && FIXNUMP (v2)) | ||
| 1301 | { | ||
| 1302 | if (XFIXNUM (v2) > XFIXNUM (v1)) | ||
| 1303 | TOP = v2; | ||
| 1304 | } | ||
| 1305 | else | ||
| 1306 | TOP = Fmax (2, &TOP); | ||
| 1307 | NEXT; | ||
| 1308 | } | ||
| 1040 | 1309 | ||
| 1041 | CASE (Bmin): | 1310 | CASE (Bmin): |
| 1042 | DISCARD (1); | 1311 | { |
| 1043 | TOP = Fmin (2, &TOP); | 1312 | Lisp_Object v2 = POP; |
| 1044 | NEXT; | 1313 | Lisp_Object v1 = TOP; |
| 1314 | if (FIXNUMP (v1) && FIXNUMP (v2)) | ||
| 1315 | { | ||
| 1316 | if (XFIXNUM (v2) < XFIXNUM (v1)) | ||
| 1317 | TOP = v2; | ||
| 1318 | } | ||
| 1319 | else | ||
| 1320 | TOP = Fmin (2, &TOP); | ||
| 1321 | NEXT; | ||
| 1322 | } | ||
| 1045 | 1323 | ||
| 1046 | CASE (Bmult): | 1324 | CASE (Bmult): |
| 1047 | DISCARD (1); | 1325 | { |
| 1048 | TOP = Ftimes (2, &TOP); | 1326 | Lisp_Object v2 = POP; |
| 1049 | NEXT; | 1327 | Lisp_Object v1 = TOP; |
| 1328 | intmax_t res; | ||
| 1329 | if (FIXNUMP (v1) && FIXNUMP (v2) | ||
| 1330 | && !INT_MULTIPLY_WRAPV (XFIXNUM (v1), XFIXNUM (v2), &res) | ||
| 1331 | && !FIXNUM_OVERFLOW_P (res)) | ||
| 1332 | TOP = make_fixnum (res); | ||
| 1333 | else | ||
| 1334 | TOP = Ftimes (2, &TOP); | ||
| 1335 | NEXT; | ||
| 1336 | } | ||
| 1050 | 1337 | ||
| 1051 | CASE (Bquo): | 1338 | CASE (Bquo): |
| 1052 | DISCARD (1); | 1339 | { |
| 1053 | TOP = Fquo (2, &TOP); | 1340 | Lisp_Object v2 = POP; |
| 1054 | NEXT; | 1341 | Lisp_Object v1 = TOP; |
| 1342 | EMACS_INT res; | ||
| 1343 | if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0 | ||
| 1344 | && (res = XFIXNUM (v1) / XFIXNUM (v2), | ||
| 1345 | !FIXNUM_OVERFLOW_P (res))) | ||
| 1346 | TOP = make_fixnum (res); | ||
| 1347 | else | ||
| 1348 | TOP = Fquo (2, &TOP); | ||
| 1349 | NEXT; | ||
| 1350 | } | ||
| 1055 | 1351 | ||
| 1056 | CASE (Brem): | 1352 | CASE (Brem): |
| 1057 | { | 1353 | { |
| 1058 | Lisp_Object v1 = POP; | 1354 | Lisp_Object v2 = POP; |
| 1059 | TOP = Frem (TOP, v1); | 1355 | Lisp_Object v1 = TOP; |
| 1356 | if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0) | ||
| 1357 | TOP = make_fixnum (XFIXNUM (v1) % XFIXNUM (v2)); | ||
| 1358 | else | ||
| 1359 | TOP = Frem (v1, v2); | ||
| 1060 | NEXT; | 1360 | NEXT; |
| 1061 | } | 1361 | } |
| 1062 | 1362 | ||
| 1063 | CASE (Bpoint): | 1363 | CASE (Bpoint): |
| 1064 | PUSH (make_natnum (PT)); | 1364 | PUSH (make_fixed_natnum (PT)); |
| 1065 | NEXT; | 1365 | NEXT; |
| 1066 | 1366 | ||
| 1067 | CASE (Bgoto_char): | 1367 | CASE (Bgoto_char): |
| @@ -1079,15 +1379,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1079 | NEXT; | 1379 | NEXT; |
| 1080 | 1380 | ||
| 1081 | CASE (Bpoint_max): | 1381 | CASE (Bpoint_max): |
| 1082 | { | 1382 | PUSH (make_fixed_natnum (ZV)); |
| 1083 | Lisp_Object v1; | 1383 | NEXT; |
| 1084 | XSETFASTINT (v1, ZV); | ||
| 1085 | PUSH (v1); | ||
| 1086 | NEXT; | ||
| 1087 | } | ||
| 1088 | 1384 | ||
| 1089 | CASE (Bpoint_min): | 1385 | CASE (Bpoint_min): |
| 1090 | PUSH (make_natnum (BEGV)); | 1386 | PUSH (make_fixed_natnum (BEGV)); |
| 1091 | NEXT; | 1387 | NEXT; |
| 1092 | 1388 | ||
| 1093 | CASE (Bchar_after): | 1389 | CASE (Bchar_after): |
| @@ -1103,7 +1399,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1103 | NEXT; | 1399 | NEXT; |
| 1104 | 1400 | ||
| 1105 | CASE (Bcurrent_column): | 1401 | CASE (Bcurrent_column): |
| 1106 | PUSH (make_natnum (current_column ())); | 1402 | PUSH (make_fixed_natnum (current_column ())); |
| 1107 | NEXT; | 1403 | NEXT; |
| 1108 | 1404 | ||
| 1109 | CASE (Bindent_to): | 1405 | CASE (Bindent_to): |
| @@ -1135,7 +1431,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1135 | NEXT; | 1431 | NEXT; |
| 1136 | 1432 | ||
| 1137 | CASE (Binteractive_p): /* Obsolete since 24.1. */ | 1433 | CASE (Binteractive_p): /* Obsolete since 24.1. */ |
| 1138 | PUSH (call0 (intern ("interactive-p"))); | 1434 | PUSH (call0 (Qinteractive_p)); |
| 1139 | NEXT; | 1435 | NEXT; |
| 1140 | 1436 | ||
| 1141 | CASE (Bforward_char): | 1437 | CASE (Bforward_char): |
| @@ -1165,13 +1461,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1165 | NEXT; | 1461 | NEXT; |
| 1166 | 1462 | ||
| 1167 | CASE (Bchar_syntax): | 1463 | CASE (Bchar_syntax): |
| 1168 | { | 1464 | TOP = Fchar_syntax (TOP); |
| 1169 | CHECK_CHARACTER (TOP); | ||
| 1170 | int c = XFASTINT (TOP); | ||
| 1171 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) | ||
| 1172 | MAKE_CHAR_MULTIBYTE (c); | ||
| 1173 | XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); | ||
| 1174 | } | ||
| 1175 | NEXT; | 1465 | NEXT; |
| 1176 | 1466 | ||
| 1177 | CASE (Bbuffer_substring): | 1467 | CASE (Bbuffer_substring): |
| @@ -1256,23 +1546,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1256 | 1546 | ||
| 1257 | CASE (Belt): | 1547 | CASE (Belt): |
| 1258 | { | 1548 | { |
| 1259 | if (CONSP (TOP)) | 1549 | Lisp_Object v2 = POP, v1 = TOP; |
| 1550 | if (CONSP (v1) && RANGED_FIXNUMP (0, v2, SMALL_LIST_LEN_MAX)) | ||
| 1260 | { | 1551 | { |
| 1261 | /* Exchange args and then do nth. */ | 1552 | /* Like the fast case for Bnth, but with args reversed. */ |
| 1262 | Lisp_Object v2 = POP, v1 = TOP; | 1553 | for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--) |
| 1263 | CHECK_NUMBER (v2); | 1554 | v1 = XCDR (v1); |
| 1264 | for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) | ||
| 1265 | { | ||
| 1266 | v1 = XCDR (v1); | ||
| 1267 | rarely_quit (n); | ||
| 1268 | } | ||
| 1269 | TOP = CAR (v1); | 1555 | TOP = CAR (v1); |
| 1270 | } | 1556 | } |
| 1271 | else | 1557 | else |
| 1272 | { | 1558 | TOP = Felt (v1, v2); |
| 1273 | Lisp_Object v1 = POP; | ||
| 1274 | TOP = Felt (TOP, v1); | ||
| 1275 | } | ||
| 1276 | NEXT; | 1559 | NEXT; |
| 1277 | } | 1560 | } |
| 1278 | 1561 | ||
| @@ -1296,15 +1579,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1296 | 1579 | ||
| 1297 | CASE (Bsetcar): | 1580 | CASE (Bsetcar): |
| 1298 | { | 1581 | { |
| 1299 | Lisp_Object v1 = POP; | 1582 | Lisp_Object newval = POP; |
| 1300 | TOP = Fsetcar (TOP, v1); | 1583 | Lisp_Object cell = TOP; |
| 1584 | CHECK_CONS (cell); | ||
| 1585 | CHECK_IMPURE (cell, XCONS (cell)); | ||
| 1586 | XSETCAR (cell, newval); | ||
| 1587 | TOP = newval; | ||
| 1301 | NEXT; | 1588 | NEXT; |
| 1302 | } | 1589 | } |
| 1303 | 1590 | ||
| 1304 | CASE (Bsetcdr): | 1591 | CASE (Bsetcdr): |
| 1305 | { | 1592 | { |
| 1306 | Lisp_Object v1 = POP; | 1593 | Lisp_Object newval = POP; |
| 1307 | TOP = Fsetcdr (TOP, v1); | 1594 | Lisp_Object cell = TOP; |
| 1595 | CHECK_CONS (cell); | ||
| 1596 | CHECK_IMPURE (cell, XCONS (cell)); | ||
| 1597 | XSETCDR (cell, newval); | ||
| 1598 | TOP = newval; | ||
| 1308 | NEXT; | 1599 | NEXT; |
| 1309 | } | 1600 | } |
| 1310 | 1601 | ||
| @@ -1329,27 +1620,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1329 | TOP = INTEGERP (TOP) ? Qt : Qnil; | 1620 | TOP = INTEGERP (TOP) ? Qt : Qnil; |
| 1330 | NEXT; | 1621 | NEXT; |
| 1331 | 1622 | ||
| 1332 | #if BYTE_CODE_SAFE | ||
| 1333 | /* These are intentionally written using 'case' syntax, | ||
| 1334 | because they are incompatible with the threaded | ||
| 1335 | interpreter. */ | ||
| 1336 | |||
| 1337 | case Bset_mark: | ||
| 1338 | error ("set-mark is an obsolete bytecode"); | ||
| 1339 | break; | ||
| 1340 | case Bscan_buffer: | ||
| 1341 | error ("scan-buffer is an obsolete bytecode"); | ||
| 1342 | break; | ||
| 1343 | #endif | ||
| 1344 | |||
| 1345 | CASE_ABORT: | 1623 | CASE_ABORT: |
| 1346 | /* Actually this is Bstack_ref with offset 0, but we use Bdup | 1624 | /* Actually this is Bstack_ref with offset 0, but we use Bdup |
| 1347 | for that instead. */ | 1625 | for that instead. */ |
| 1348 | /* CASE (Bstack_ref): */ | 1626 | /* CASE (Bstack_ref): */ |
| 1349 | call3 (Qerror, | 1627 | error ("Invalid byte opcode: op=%d, ptr=%"pD"d", |
| 1350 | build_string ("Invalid byte opcode: op=%s, ptr=%d"), | 1628 | op, pc - 1 - bytestr_data); |
| 1351 | make_number (op), | ||
| 1352 | make_number (pc - 1 - bytestr_data)); | ||
| 1353 | 1629 | ||
| 1354 | /* Handy byte-codes for lexical binding. */ | 1630 | /* Handy byte-codes for lexical binding. */ |
| 1355 | CASE (Bstack_ref1): | 1631 | CASE (Bstack_ref1): |
| @@ -1402,28 +1678,27 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1402 | /* TODO: Perhaps introduce another byte-code for switch when the | 1678 | /* TODO: Perhaps introduce another byte-code for switch when the |
| 1403 | number of cases is less, which uses a simple vector for linear | 1679 | number of cases is less, which uses a simple vector for linear |
| 1404 | search as the jump table. */ | 1680 | search as the jump table. */ |
| 1681 | |||
| 1682 | /* TODO: Instead of pushing the table in a separate | ||
| 1683 | Bconstant op, use an immediate argument (maybe separate | ||
| 1684 | switch opcodes for 1-byte and 2-byte constant indices). | ||
| 1685 | This would also get rid of some hacks that assume each | ||
| 1686 | Bswitch to be preceded by a Bconstant. */ | ||
| 1405 | Lisp_Object jmp_table = POP; | 1687 | Lisp_Object jmp_table = POP; |
| 1406 | if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) | 1688 | if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) |
| 1407 | emacs_abort (); | 1689 | emacs_abort (); |
| 1408 | Lisp_Object v1 = POP; | 1690 | Lisp_Object v1 = POP; |
| 1409 | ptrdiff_t i; | 1691 | ptrdiff_t i; |
| 1410 | struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); | 1692 | struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); |
| 1411 | 1693 | ||
| 1412 | /* h->count is a faster approximation for HASH_TABLE_SIZE (h) | 1694 | /* h->count is a faster approximation for HASH_TABLE_SIZE (h) |
| 1413 | here. */ | 1695 | here. */ |
| 1414 | if (h->count <= 5) | 1696 | if (h->count <= 5 && !h->test.cmpfn) |
| 1415 | { /* Do a linear search if there are not many cases | 1697 | { /* Do a linear search if there are not many cases |
| 1416 | FIXME: 5 is arbitrarily chosen. */ | 1698 | FIXME: 5 is arbitrarily chosen. */ |
| 1417 | Lisp_Object hash_code = h->test.cmpfn | 1699 | for (i = h->count; 0 <= --i; ) |
| 1418 | ? make_number (h->test.hashfn (&h->test, v1)) : Qnil; | 1700 | if (EQ (v1, HASH_KEY (h, i))) |
| 1419 | 1701 | break; | |
| 1420 | for (i = h->count; 0 <= --i; ) | ||
| 1421 | if (EQ (v1, HASH_KEY (h, i)) | ||
| 1422 | || (h->test.cmpfn | ||
| 1423 | && EQ (hash_code, HASH_HASH (h, i)) | ||
| 1424 | && h->test.cmpfn (&h->test, v1, HASH_KEY (h, i)))) | ||
| 1425 | break; | ||
| 1426 | |||
| 1427 | } | 1702 | } |
| 1428 | else | 1703 | else |
| 1429 | i = hash_lookup (h, v1, NULL); | 1704 | i = hash_lookup (h, v1, NULL); |
| @@ -1431,9 +1706,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1431 | if (i >= 0) | 1706 | if (i >= 0) |
| 1432 | { | 1707 | { |
| 1433 | Lisp_Object val = HASH_VALUE (h, i); | 1708 | Lisp_Object val = HASH_VALUE (h, i); |
| 1434 | if (BYTE_CODE_SAFE && !INTEGERP (val)) | 1709 | if (BYTE_CODE_SAFE && !FIXNUMP (val)) |
| 1435 | emacs_abort (); | 1710 | emacs_abort (); |
| 1436 | op = XINT (val); | 1711 | op = XFIXNUM (val); |
| 1437 | goto op_branch; | 1712 | goto op_branch; |
| 1438 | } | 1713 | } |
| 1439 | } | 1714 | } |
| @@ -1451,16 +1726,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1451 | 1726 | ||
| 1452 | exit: | 1727 | exit: |
| 1453 | 1728 | ||
| 1454 | /* Binds and unbinds are supposed to be compiled balanced. */ | 1729 | bc->fp = bc->fp->saved_fp; |
| 1455 | if (SPECPDL_INDEX () != count) | ||
| 1456 | { | ||
| 1457 | if (SPECPDL_INDEX () > count) | ||
| 1458 | unbind_to (count, Qnil); | ||
| 1459 | error ("binding stack not balanced (serious byte compiler bug)"); | ||
| 1460 | } | ||
| 1461 | 1730 | ||
| 1462 | Lisp_Object result = TOP; | 1731 | Lisp_Object result = TOP; |
| 1463 | SAFE_FREE (); | ||
| 1464 | return result; | 1732 | return result; |
| 1465 | } | 1733 | } |
| 1466 | 1734 | ||
| @@ -1468,20 +1736,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1468 | Lisp_Object | 1736 | Lisp_Object |
| 1469 | get_byte_code_arity (Lisp_Object args_template) | 1737 | get_byte_code_arity (Lisp_Object args_template) |
| 1470 | { | 1738 | { |
| 1471 | eassert (NATNUMP (args_template)); | 1739 | eassert (FIXNATP (args_template)); |
| 1472 | EMACS_INT at = XINT (args_template); | 1740 | EMACS_INT at = XFIXNUM (args_template); |
| 1473 | bool rest = (at & 128) != 0; | 1741 | bool rest = (at & 128) != 0; |
| 1474 | int mandatory = at & 127; | 1742 | int mandatory = at & 127; |
| 1475 | EMACS_INT nonrest = at >> 8; | 1743 | EMACS_INT nonrest = at >> 8; |
| 1476 | 1744 | ||
| 1477 | return Fcons (make_number (mandatory), | 1745 | return Fcons (make_fixnum (mandatory), |
| 1478 | rest ? Qmany : make_number (nonrest)); | 1746 | rest ? Qmany : make_fixnum (nonrest)); |
| 1479 | } | 1747 | } |
| 1480 | 1748 | ||
| 1481 | void | 1749 | void |
| 1482 | syms_of_bytecode (void) | 1750 | syms_of_bytecode (void) |
| 1483 | { | 1751 | { |
| 1752 | DEFSYM (Qinteractive_p, "interactive-p"); | ||
| 1753 | |||
| 1484 | defsubr (&Sbyte_code); | 1754 | defsubr (&Sbyte_code); |
| 1755 | defsubr (&Sinternal_stack_stats); | ||
| 1485 | 1756 | ||
| 1486 | #ifdef BYTE_CODE_METER | 1757 | #ifdef BYTE_CODE_METER |
| 1487 | 1758 | ||
| @@ -1500,13 +1771,9 @@ If a symbol has a property named `byte-code-meter' whose value is an | |||
| 1500 | integer, it is incremented each time that symbol's function is called. */); | 1771 | integer, it is incremented each time that symbol's function is called. */); |
| 1501 | 1772 | ||
| 1502 | byte_metering_on = false; | 1773 | byte_metering_on = false; |
| 1503 | Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); | 1774 | Vbyte_code_meter = make_nil_vector (256); |
| 1504 | DEFSYM (Qbyte_code_meter, "byte-code-meter"); | 1775 | DEFSYM (Qbyte_code_meter, "byte-code-meter"); |
| 1505 | { | 1776 | for (int i = 0; i < 256; i++) |
| 1506 | int i = 256; | 1777 | ASET (Vbyte_code_meter, i, make_vector (256, make_fixnum (0))); |
| 1507 | while (i--) | ||
| 1508 | ASET (Vbyte_code_meter, i, | ||
| 1509 | Fmake_vector (make_number (256), make_number (0))); | ||
| 1510 | } | ||
| 1511 | #endif | 1778 | #endif |
| 1512 | } | 1779 | } |