aboutsummaryrefslogtreecommitdiffstats
path: root/src/bytecode.c
diff options
context:
space:
mode:
authorRichard M. Stallman1991-11-26 05:00:30 +0000
committerRichard M. Stallman1991-11-26 05:00:30 +0000
commit3ffbe76bacb01bd11c6c880053e44f5ede6c3a68 (patch)
tree0eb7b0902a1709771f0146b9bcb15de4c5d227d4 /src/bytecode.c
parent0feac52d0bd2873a86355dc1804acf7fd77a4a6b (diff)
downloademacs-3ffbe76bacb01bd11c6c880053e44f5ede6c3a68.tar.gz
emacs-3ffbe76bacb01bd11c6c880053e44f5ede6c3a68.zip
*** empty log message ***
Diffstat (limited to 'src/bytecode.c')
-rw-r--r--src/bytecode.c116
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.
20hacked on by jwz@lucid.com 17-jun-91 20hacked 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
32by Hallvard: 30by 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:
55Lisp_Object Vbyte_code_meter, Qbyte_code_meter; 52Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
56int byte_metering_on; 53int 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
81Lisp_Object Qbytecode; 80Lisp_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}