diff options
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 116 |
1 files changed, 64 insertions, 52 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index 249cb119fc4..d8de7ebaebe 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -20,21 +20,18 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |||
| 20 | hacked on by jwz@lucid.com 17-jun-91 | 20 | hacked on by jwz@lucid.com 17-jun-91 |
| 21 | o added a compile-time switch to turn on simple sanity checking; | 21 | o added a compile-time switch to turn on simple sanity checking; |
| 22 | o put back the obsolete byte-codes for error-detection; | 22 | o put back the obsolete byte-codes for error-detection; |
| 23 | o put back fset, symbol-function, and read-char because I don't | ||
| 24 | see any reason for them to have been removed; | ||
| 25 | o added a new instruction, unbind_all, which I will use for | 23 | o added a new instruction, unbind_all, which I will use for |
| 26 | tail-recursion elimination; | 24 | tail-recursion elimination; |
| 27 | o made temp_output_buffer_show() be called with the right number | 25 | o made temp_output_buffer_show be called with the right number |
| 28 | of args; | 26 | of args; |
| 29 | o made the new bytecodes be called with args in the right order; | 27 | o made the new bytecodes be called with args in the right order; |
| 30 | o added metering support. | 28 | o added metering support. |
| 31 | 29 | ||
| 32 | by Hallvard: | 30 | by Hallvard: |
| 33 | o added relative jump instructions. | 31 | o added relative jump instructions; |
| 34 | o all conditionals now only do QUIT if they jump. | 32 | o all conditionals now only do QUIT if they jump. |
| 35 | */ | 33 | */ |
| 36 | 34 | ||
| 37 | |||
| 38 | #include "config.h" | 35 | #include "config.h" |
| 39 | #include "lisp.h" | 36 | #include "lisp.h" |
| 40 | #include "buffer.h" | 37 | #include "buffer.h" |
| @@ -46,8 +43,8 @@ by Hallvard: | |||
| 46 | * | 43 | * |
| 47 | * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. | 44 | * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. |
| 48 | */ | 45 | */ |
| 49 | #define BYTE_CODE_SAFE | 46 | /* #define BYTE_CODE_SAFE */ |
| 50 | #define BYTE_CODE_METER | 47 | /* #define BYTE_CODE_METER */ |
| 51 | 48 | ||
| 52 | 49 | ||
| 53 | #ifdef BYTE_CODE_METER | 50 | #ifdef BYTE_CODE_METER |
| @@ -55,27 +52,29 @@ by Hallvard: | |||
| 55 | Lisp_Object Vbyte_code_meter, Qbyte_code_meter; | 52 | Lisp_Object Vbyte_code_meter, Qbyte_code_meter; |
| 56 | int byte_metering_on; | 53 | int byte_metering_on; |
| 57 | 54 | ||
| 58 | # define METER_2(code1,code2) \ | 55 | #define METER_2(code1, code2) \ |
| 59 | XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ | 56 | XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ |
| 60 | ->contents[(code2)]) | 57 | ->contents[(code2)]) |
| 61 | 58 | ||
| 62 | # define METER_1(code) METER_2 (0,(code)) | 59 | #define METER_1(code) METER_2 (0, (code)) |
| 63 | 60 | ||
| 64 | # define METER_CODE(last_code, this_code) { \ | 61 | #define METER_CODE(last_code, this_code) \ |
| 65 | if (byte_metering_on) { \ | 62 | { \ |
| 66 | if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ | 63 | if (byte_metering_on) \ |
| 67 | METER_1 (this_code) ++; \ | 64 | { \ |
| 68 | if (last_code && \ | 65 | if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ |
| 69 | METER_2 (last_code,this_code) != ((1<<VALBITS)-1)) \ | 66 | METER_1 (this_code)++; \ |
| 70 | METER_2 (last_code,this_code) ++; \ | 67 | if (last_code \ |
| 71 | } \ | 68 | && METER_2 (last_code, this_code) != ((1<<VALBITS)-1)) \ |
| 72 | } | 69 | METER_2 (last_code, this_code)++; \ |
| 70 | } \ | ||
| 71 | } | ||
| 73 | 72 | ||
| 74 | #else /* ! BYTE_CODE_METER */ | 73 | #else /* no BYTE_CODE_METER */ |
| 75 | 74 | ||
| 76 | # define meter_code(last_code, this_code) | 75 | #define METER_CODE(last_code, this_code) |
| 77 | 76 | ||
| 78 | #endif | 77 | #endif /* no BYTE_CODE_METER */ |
| 79 | 78 | ||
| 80 | 79 | ||
| 81 | Lisp_Object Qbytecode; | 80 | Lisp_Object Qbytecode; |
| @@ -107,9 +106,9 @@ Lisp_Object Qbytecode; | |||
| 107 | #define Baref 0110 | 106 | #define Baref 0110 |
| 108 | #define Baset 0111 | 107 | #define Baset 0111 |
| 109 | #define Bsymbol_value 0112 | 108 | #define Bsymbol_value 0112 |
| 110 | #define Bsymbol_function 0113 | 109 | #define Bsymbol_function 0113 /* no longer generated as of v19 */ |
| 111 | #define Bset 0114 | 110 | #define Bset 0114 |
| 112 | #define Bfset 0115 | 111 | #define Bfset 0115 /* no longer generated as of v19 */ |
| 113 | #define Bget 0116 | 112 | #define Bget 0116 |
| 114 | #define Bsubstring 0117 | 113 | #define Bsubstring 0117 |
| 115 | #define Bconcat2 0120 | 114 | #define Bconcat2 0120 |
| @@ -217,6 +216,7 @@ Lisp_Object Qbytecode; | |||
| 217 | 216 | ||
| 218 | #define BlistN 0257 | 217 | #define BlistN 0257 |
| 219 | #define BconcatN 0260 | 218 | #define BconcatN 0260 |
| 219 | #define BinsertN 0261 | ||
| 220 | 220 | ||
| 221 | #define Bconstant 0300 | 221 | #define Bconstant 0300 |
| 222 | #define CONSTANTLIM 0100 | 222 | #define CONSTANTLIM 0100 |
| @@ -301,11 +301,10 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 301 | { | 301 | { |
| 302 | #ifdef BYTE_CODE_SAFE | 302 | #ifdef BYTE_CODE_SAFE |
| 303 | if (stackp > stacke) | 303 | if (stackp > stacke) |
| 304 | error ( | 304 | error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", |
| 305 | "Stack overflow in byte code (byte compiler bug), pc = %d, depth = %d", | ||
| 306 | pc - XSTRING (string_saved)->data, stacke - stackp); | 305 | pc - XSTRING (string_saved)->data, stacke - stackp); |
| 307 | if (stackp < stack) | 306 | if (stackp < stack) |
| 308 | error ("Stack underflow in byte code (byte compiler bug), pc = %d", | 307 | error ("Byte code stack underflow (byte compiler bug), pc %d", |
| 309 | pc - XSTRING (string_saved)->data); | 308 | pc - XSTRING (string_saved)->data); |
| 310 | #endif | 309 | #endif |
| 311 | 310 | ||
| @@ -406,7 +405,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 406 | case Bcall+4: case Bcall+5: | 405 | case Bcall+4: case Bcall+5: |
| 407 | op -= Bcall; | 406 | op -= Bcall; |
| 408 | docall: | 407 | docall: |
| 409 | DISCARD(op); | 408 | DISCARD (op); |
| 410 | #ifdef BYTE_CODE_METER | 409 | #ifdef BYTE_CODE_METER |
| 411 | if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol) | 410 | if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol) |
| 412 | { | 411 | { |
| @@ -419,7 +418,14 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 419 | } | 418 | } |
| 420 | } | 419 | } |
| 421 | #endif | 420 | #endif |
| 421 | /* The frobbing of gcpro3 was lost by jwz's changes in June 91 | ||
| 422 | and then reinserted by jwz in Nov 91. */ | ||
| 423 | /* Remove protection from the args we are giving to Ffuncall. | ||
| 424 | FFuncall will protect them, and double protection would | ||
| 425 | cause disasters. */ | ||
| 426 | gcpro3.nvars = &TOP - stack - 1; | ||
| 422 | TOP = Ffuncall (op + 1, &TOP); | 427 | TOP = Ffuncall (op + 1, &TOP); |
| 428 | gcpro3.nvars = XFASTINT (maxdepth); | ||
| 423 | break; | 429 | break; |
| 424 | 430 | ||
| 425 | case Bunbind+6: | 431 | case Bunbind+6: |
| @@ -439,8 +445,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 439 | 445 | ||
| 440 | case Bunbind_all: | 446 | case Bunbind_all: |
| 441 | /* To unbind back to the beginning of this frame. Not used yet, | 447 | /* To unbind back to the beginning of this frame. Not used yet, |
| 442 | but wil be needed for tail-recursion elimination. | 448 | but will be needed for tail-recursion elimination. */ |
| 443 | */ | ||
| 444 | unbind_to (count, Qnil); | 449 | unbind_to (count, Qnil); |
| 445 | break; | 450 | break; |
| 446 | 451 | ||
| @@ -475,7 +480,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 475 | QUIT; | 480 | QUIT; |
| 476 | pc = XSTRING (string_saved)->data + op; | 481 | pc = XSTRING (string_saved)->data + op; |
| 477 | } | 482 | } |
| 478 | else DISCARD(1); | 483 | else DISCARD (1); |
| 479 | break; | 484 | break; |
| 480 | 485 | ||
| 481 | case Bgotoifnonnilelsepop: | 486 | case Bgotoifnonnilelsepop: |
| @@ -485,7 +490,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 485 | QUIT; | 490 | QUIT; |
| 486 | pc = XSTRING (string_saved)->data + op; | 491 | pc = XSTRING (string_saved)->data + op; |
| 487 | } | 492 | } |
| 488 | else DISCARD(1); | 493 | else DISCARD (1); |
| 489 | break; | 494 | break; |
| 490 | 495 | ||
| 491 | case BRgoto: | 496 | case BRgoto: |
| @@ -518,7 +523,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 518 | QUIT; | 523 | QUIT; |
| 519 | pc += op - 128; | 524 | pc += op - 128; |
| 520 | } | 525 | } |
| 521 | else DISCARD(1); | 526 | else DISCARD (1); |
| 522 | break; | 527 | break; |
| 523 | 528 | ||
| 524 | case BRgotoifnonnilelsepop: | 529 | case BRgotoifnonnilelsepop: |
| @@ -528,7 +533,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 528 | QUIT; | 533 | QUIT; |
| 529 | pc += op - 128; | 534 | pc += op - 128; |
| 530 | } | 535 | } |
| 531 | else DISCARD(1); | 536 | else DISCARD (1); |
| 532 | break; | 537 | break; |
| 533 | 538 | ||
| 534 | case Breturn: | 539 | case Breturn: |
| @@ -536,7 +541,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 536 | goto exit; | 541 | goto exit; |
| 537 | 542 | ||
| 538 | case Bdiscard: | 543 | case Bdiscard: |
| 539 | DISCARD(1); | 544 | DISCARD (1); |
| 540 | break; | 545 | break; |
| 541 | 546 | ||
| 542 | case Bdup: | 547 | case Bdup: |
| @@ -671,12 +676,12 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 671 | break; | 676 | break; |
| 672 | 677 | ||
| 673 | case Blist3: | 678 | case Blist3: |
| 674 | DISCARD(2); | 679 | DISCARD (2); |
| 675 | TOP = Flist (3, &TOP); | 680 | TOP = Flist (3, &TOP); |
| 676 | break; | 681 | break; |
| 677 | 682 | ||
| 678 | case Blist4: | 683 | case Blist4: |
| 679 | DISCARD(3); | 684 | DISCARD (3); |
| 680 | TOP = Flist (4, &TOP); | 685 | TOP = Flist (4, &TOP); |
| 681 | break; | 686 | break; |
| 682 | 687 | ||
| @@ -729,17 +734,17 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 729 | break; | 734 | break; |
| 730 | 735 | ||
| 731 | case Bconcat2: | 736 | case Bconcat2: |
| 732 | DISCARD(1); | 737 | DISCARD (1); |
| 733 | TOP = Fconcat (2, &TOP); | 738 | TOP = Fconcat (2, &TOP); |
| 734 | break; | 739 | break; |
| 735 | 740 | ||
| 736 | case Bconcat3: | 741 | case Bconcat3: |
| 737 | DISCARD(2); | 742 | DISCARD (2); |
| 738 | TOP = Fconcat (3, &TOP); | 743 | TOP = Fconcat (3, &TOP); |
| 739 | break; | 744 | break; |
| 740 | 745 | ||
| 741 | case Bconcat4: | 746 | case Bconcat4: |
| 742 | DISCARD(3); | 747 | DISCARD (3); |
| 743 | TOP = Fconcat (4, &TOP); | 748 | TOP = Fconcat (4, &TOP); |
| 744 | break; | 749 | break; |
| 745 | 750 | ||
| @@ -799,7 +804,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 799 | break; | 804 | break; |
| 800 | 805 | ||
| 801 | case Bdiff: | 806 | case Bdiff: |
| 802 | DISCARD(1); | 807 | DISCARD (1); |
| 803 | TOP = Fminus (2, &TOP); | 808 | TOP = Fminus (2, &TOP); |
| 804 | break; | 809 | break; |
| 805 | 810 | ||
| @@ -815,27 +820,27 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 815 | break; | 820 | break; |
| 816 | 821 | ||
| 817 | case Bplus: | 822 | case Bplus: |
| 818 | DISCARD(1); | 823 | DISCARD (1); |
| 819 | TOP = Fplus (2, &TOP); | 824 | TOP = Fplus (2, &TOP); |
| 820 | break; | 825 | break; |
| 821 | 826 | ||
| 822 | case Bmax: | 827 | case Bmax: |
| 823 | DISCARD(1); | 828 | DISCARD (1); |
| 824 | TOP = Fmax (2, &TOP); | 829 | TOP = Fmax (2, &TOP); |
| 825 | break; | 830 | break; |
| 826 | 831 | ||
| 827 | case Bmin: | 832 | case Bmin: |
| 828 | DISCARD(1); | 833 | DISCARD (1); |
| 829 | TOP = Fmin (2, &TOP); | 834 | TOP = Fmin (2, &TOP); |
| 830 | break; | 835 | break; |
| 831 | 836 | ||
| 832 | case Bmult: | 837 | case Bmult: |
| 833 | DISCARD(1); | 838 | DISCARD (1); |
| 834 | TOP = Ftimes (2, &TOP); | 839 | TOP = Ftimes (2, &TOP); |
| 835 | break; | 840 | break; |
| 836 | 841 | ||
| 837 | case Bquo: | 842 | case Bquo: |
| 838 | DISCARD(1); | 843 | DISCARD (1); |
| 839 | TOP = Fquo (2, &TOP); | 844 | TOP = Fquo (2, &TOP); |
| 840 | break; | 845 | break; |
| 841 | 846 | ||
| @@ -857,6 +862,12 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 857 | TOP = Finsert (1, &TOP); | 862 | TOP = Finsert (1, &TOP); |
| 858 | break; | 863 | break; |
| 859 | 864 | ||
| 865 | case BinsertN: | ||
| 866 | op = FETCH; | ||
| 867 | DISCARD (op - 1); | ||
| 868 | TOP = Finsert (op, &TOP); | ||
| 869 | break; | ||
| 870 | |||
| 860 | case Bpoint_max: | 871 | case Bpoint_max: |
| 861 | XFASTINT (v1) = ZV; | 872 | XFASTINT (v1) = ZV; |
| 862 | PUSH (v1); | 873 | PUSH (v1); |
| @@ -1068,7 +1079,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 1068 | break; | 1079 | break; |
| 1069 | 1080 | ||
| 1070 | case Bnconc: | 1081 | case Bnconc: |
| 1071 | DISCARD(1); | 1082 | DISCARD (1); |
| 1072 | TOP = Fnconc (2, &TOP); | 1083 | TOP = Fnconc (2, &TOP); |
| 1073 | break; | 1084 | break; |
| 1074 | 1085 | ||
| @@ -1089,7 +1100,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 1089 | error ("scan-buffer is an obsolete bytecode"); | 1100 | error ("scan-buffer is an obsolete bytecode"); |
| 1090 | break; | 1101 | break; |
| 1091 | case Bmark: | 1102 | case Bmark: |
| 1092 | error("mark is an obsolete bytecode"); | 1103 | error ("mark is an obsolete bytecode"); |
| 1093 | break; | 1104 | break; |
| 1094 | #endif | 1105 | #endif |
| 1095 | 1106 | ||
| @@ -1128,17 +1139,18 @@ syms_of_bytecode () | |||
| 1128 | #ifdef BYTE_CODE_METER | 1139 | #ifdef BYTE_CODE_METER |
| 1129 | 1140 | ||
| 1130 | DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, | 1141 | DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, |
| 1131 | "a vector of vectors which holds a histogram of byte-code usage."); | 1142 | "A vector of vectors which holds a histogram of byte-code usage."); |
| 1132 | DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, ""); | 1143 | DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, ""); |
| 1133 | 1144 | ||
| 1134 | byte_metering_on = 0; | 1145 | byte_metering_on = 0; |
| 1135 | Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0)); | 1146 | Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); |
| 1147 | Qbyte_code_meter = intern ("byte-code-meter"); | ||
| 1136 | staticpro (&Qbyte_code_meter); | 1148 | staticpro (&Qbyte_code_meter); |
| 1137 | { | 1149 | { |
| 1138 | int i = 256; | 1150 | int i = 256; |
| 1139 | while (i--) | 1151 | while (i--) |
| 1140 | XVECTOR(Vbyte_code_meter)->contents[i] = | 1152 | XVECTOR (Vbyte_code_meter)->contents[i] = |
| 1141 | Fmake_vector(make_number(256), make_number(0)); | 1153 | Fmake_vector (make_number (256), make_number (0)); |
| 1142 | } | 1154 | } |
| 1143 | #endif | 1155 | #endif |
| 1144 | } | 1156 | } |