Mercurial > emacs

comparison src/bytecode.c @ 396:d0eb77a4d8f7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** empty log message ***
author Jim Blandy <jimb@redhat.com>
date Fri, 16 Aug 1991 04:13:50 +0000
parents 88bee8093f43
children 43e88c4db330
comparison
equal deleted inserted replaced
395:b5cc63711808 396:d0eb77a4d8f7
15 15
16 You should have received a copy of the GNU General Public License 16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to 17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19 19
20 hacked on by jwz 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 23 o put back fset, symbol-function, and read-char because I don't
24 see any reason for them to have been removed; 24 see any reason for them to have been removed;
25 o added a new instruction, unbind_all, which I will use for 25 o added a new instruction, unbind_all, which I will use for
28 of args; 28 of args;
29 o made the new bytecodes be called with args in the right order; 29 o made the new bytecodes be called with args in the right order;
30 o added metering support. 30 o added metering support.
31 31
32 by Hallvard: 32 by Hallvard:
33 o added relative jump instructions; 33 o added relative jump instructions.
34 o all conditionals now only do QUIT if they jump. 34 o all conditionals now only do QUIT if they jump.
35 */ 35 */
36 36
37 37
38 #include "config.h" 38 #include "config.h"
39 #include "lisp.h" 39 #include "lisp.h"
40 #include "buffer.h" 40 #include "buffer.h"
41 #include "syntax.h" 41 #include "syntax.h"
42 42
43 /* Define this to enable some minor sanity checking 43 /*
44 (useful for debugging the byte compiler...) 44 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
45 * debugging the byte compiler...)
46 *
47 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
45 */ 48 */
46 #define BYTE_CODE_SAFE 49 #define BYTE_CODE_SAFE
47
48 /* Define this to enable generation of a histogram of byte-op usage.
49 */
50 #define BYTE_CODE_METER 50 #define BYTE_CODE_METER
51 51
52 52
53 #ifdef BYTE_CODE_METER 53 #ifdef BYTE_CODE_METER
54 54
55 Lisp_Object Vbyte_code_meter; 55 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
56 int byte_metering_on; 56 int byte_metering_on;
57 57
58 # define METER_2(code1,code2) \ 58 # define METER_2(code1,code2) \
59 XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ 59 XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
60 ->contents[(code2)]) 60 ->contents[(code2)])
105 #define Blist4 0106 105 #define Blist4 0106
106 #define Blength 0107 106 #define Blength 0107
107 #define Baref 0110 107 #define Baref 0110
108 #define Baset 0111 108 #define Baset 0111
109 #define Bsymbol_value 0112 109 #define Bsymbol_value 0112
110 #define Bsymbol_function 0113 /* no longer generated as of v19 */ 110 #define Bsymbol_function 0113
111 #define Bset 0114 111 #define Bset 0114
112 #define Bfset 0115 /* no longer generated as of v19 */ 112 #define Bfset 0115
113 #define Bget 0116 113 #define Bget 0116
114 #define Bsubstring 0117 114 #define Bsubstring 0117
115 #define Bconcat2 0120 115 #define Bconcat2 0120
116 #define Bconcat3 0121 116 #define Bconcat3 0121
117 #define Bconcat4 0122 117 #define Bconcat4 0122
145 #define Beobp 0155 145 #define Beobp 0155
146 #define Bbolp 0156 146 #define Bbolp 0156
147 #define Bbobp 0157 147 #define Bbobp 0157
148 #define Bcurrent_buffer 0160 148 #define Bcurrent_buffer 0160
149 #define Bset_buffer 0161 149 #define Bset_buffer 0161
150 #define Bread_char 0162 150 #define Bread_char 0162 /* No longer generated as of v19 */
151 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ 151 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
152 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ 152 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
153 153
154 #define Bforward_char 0165 154 #define Bforward_char 0165
155 #define Bforward_word 0166 155 #define Bforward_word 0166
159 #define Bchar_syntax 0172 159 #define Bchar_syntax 0172
160 #define Bbuffer_substring 0173 160 #define Bbuffer_substring 0173
161 #define Bdelete_region 0174 161 #define Bdelete_region 0174
162 #define Bnarrow_to_region 0175 162 #define Bnarrow_to_region 0175
163 #define Bwiden 0176 163 #define Bwiden 0176
164 #define Bend_of_line 0177
164 165
165 #define Bconstant2 0201 166 #define Bconstant2 0201
166 #define Bgoto 0202 167 #define Bgoto 0202
167 #define Bgotoifnil 0203 168 #define Bgotoifnil 0203
168 #define Bgotoifnonnil 0204 169 #define Bgotoifnonnil 0204
181 #define Bcondition_case 0217 182 #define Bcondition_case 0217
182 #define Btemp_output_buffer_setup 0220 183 #define Btemp_output_buffer_setup 0220
183 #define Btemp_output_buffer_show 0221 184 #define Btemp_output_buffer_show 0221
184 185
185 #define Bunbind_all 0222 186 #define Bunbind_all 0222
187
188 #define Bset_marker 0223
189 #define Bmatch_beginning 0224
190 #define Bmatch_end 0225
191 #define Bupcase 0226
192 #define Bdowncase 0227
186 193
187 #define Bstringeqlsign 0230 194 #define Bstringeqlsign 0230
188 #define Bstringlss 0231 195 #define Bstringlss 0231
189 #define Bequal 0232 196 #define Bequal 0232
190 #define Bnthcdr 0233 197 #define Bnthcdr 0233
199 #define Bnconc 0244 206 #define Bnconc 0244
200 #define Bquo 0245 207 #define Bquo 0245
201 #define Brem 0246 208 #define Brem 0246
202 #define Bnumberp 0247 209 #define Bnumberp 0247
203 #define Bintegerp 0250 210 #define Bintegerp 0250
211
212 #define BRgoto 0252
213 #define BRgotoifnil 0253
214 #define BRgotoifnonnil 0254
215 #define BRgotoifnilelsepop 0255
216 #define BRgotoifnonnilelsepop 0256
217
218 #define BlistN 0257
219 #define BconcatN 0260
204 220
205 #define Bconstant 0300 221 #define Bconstant 0300
206 #define CONSTANTLIM 0100 222 #define CONSTANTLIM 0100
207 223
208 /* Fetch the next byte from the bytecode stream */ 224 /* Fetch the next byte from the bytecode stream */
389 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3: 405 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
390 case Bcall+4: case Bcall+5: 406 case Bcall+4: case Bcall+5:
391 op -= Bcall; 407 op -= Bcall;
392 docall: 408 docall:
393 DISCARD(op); 409 DISCARD(op);
410 #ifdef BYTE_CODE_METER
411 if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
412 {
413 v1 = TOP;
414 v2 = Fget (v1, Qbyte_code_meter);
415 if (XTYPE (v2) == Lisp_Int)
416 {
417 XSETINT (v2, XINT (v2) + 1);
418 Fput (v1, Qbyte_code_meter, v2);
419 }
420 }
421 #endif
394 TOP = Ffuncall (op + 1, &TOP); 422 TOP = Ffuncall (op + 1, &TOP);
395 break; 423 break;
396 424
397 case Bunbind+6: 425 case Bunbind+6:
398 op = FETCH; 426 op = FETCH;
454 op = FETCH2; 482 op = FETCH2;
455 if (!NULL (TOP)) 483 if (!NULL (TOP))
456 { 484 {
457 QUIT; 485 QUIT;
458 pc = XSTRING (string_saved)->data + op; 486 pc = XSTRING (string_saved)->data + op;
487 }
488 else DISCARD(1);
489 break;
490
491 case BRgoto:
492 QUIT;
493 pc += *pc - 127;
494 break;
495
496 case BRgotoifnil:
497 if (NULL (POP))
498 {
499 QUIT;
500 pc += *pc - 128;
501 }
502 pc++;
503 break;
504
505 case BRgotoifnonnil:
506 if (!NULL (POP))
507 {
508 QUIT;
509 pc += *pc - 128;
510 }
511 pc++;
512 break;
513
514 case BRgotoifnilelsepop:
515 op = *pc++;
516 if (NULL (TOP))
517 {
518 QUIT;
519 pc += op - 128;
520 }
521 else DISCARD(1);
522 break;
523
524 case BRgotoifnonnilelsepop:
525 op = *pc++;
526 if (!NULL (TOP))
527 {
528 QUIT;
529 pc += op - 128;
459 } 530 }
460 else DISCARD(1); 531 else DISCARD(1);
461 break; 532 break;
462 533
463 case Breturn: 534 case Breturn:
607 case Blist4: 678 case Blist4:
608 DISCARD(3); 679 DISCARD(3);
609 TOP = Flist (4, &TOP); 680 TOP = Flist (4, &TOP);
610 break; 681 break;
611 682
683 case BlistN:
684 op = FETCH;
685 DISCARD (op - 1);
686 TOP = Flist (op, &TOP);
687 break;
688
612 case Blength: 689 case Blength:
613 TOP = Flength (TOP); 690 TOP = Flength (TOP);
614 break; 691 break;
615 692
616 case Baref: 693 case Baref:
662 break; 739 break;
663 740
664 case Bconcat4: 741 case Bconcat4:
665 DISCARD(3); 742 DISCARD(3);
666 TOP = Fconcat (4, &TOP); 743 TOP = Fconcat (4, &TOP);
744 break;
745
746 case BconcatN:
747 op = FETCH;
748 DISCARD (op - 1);
749 TOP = Fconcat (op, &TOP);
667 break; 750 break;
668 751
669 case Bsub1: 752 case Bsub1:
670 v1 = TOP; 753 v1 = TOP;
671 if (XTYPE (v1) == Lisp_Int) 754 if (XTYPE (v1) == Lisp_Int)
756 TOP = Fquo (2, &TOP); 839 TOP = Fquo (2, &TOP);
757 break; 840 break;
758 841
759 case Brem: 842 case Brem:
760 v1 = POP; 843 v1 = POP;
761 /* This had args in the wrong order. -- jwz */
762 TOP = Frem (TOP, v1); 844 TOP = Frem (TOP, v1);
763 break; 845 break;
764 846
765 case Bpoint: 847 case Bpoint:
766 XFASTINT (v1) = point; 848 XFASTINT (v1) = point;
840 case Binteractive_p: 922 case Binteractive_p:
841 PUSH (Finteractive_p ()); 923 PUSH (Finteractive_p ());
842 break; 924 break;
843 925
844 case Bforward_char: 926 case Bforward_char:
845 /* This was wrong! --jwz */
846 TOP = Fforward_char (TOP); 927 TOP = Fforward_char (TOP);
847 break; 928 break;
848 929
849 case Bforward_word: 930 case Bforward_word:
850 /* This was wrong! --jwz */
851 TOP = Fforward_word (TOP); 931 TOP = Fforward_word (TOP);
852 break; 932 break;
853 933
854 case Bskip_chars_forward: 934 case Bskip_chars_forward:
855 /* This was wrong! --jwz */
856 v1 = POP; 935 v1 = POP;
857 TOP = Fskip_chars_forward (TOP, v1); 936 TOP = Fskip_chars_forward (TOP, v1);
858 break; 937 break;
859 938
860 case Bskip_chars_backward: 939 case Bskip_chars_backward:
861 /* This was wrong! --jwz */
862 v1 = POP; 940 v1 = POP;
863 TOP = Fskip_chars_backward (TOP, v1); 941 TOP = Fskip_chars_backward (TOP, v1);
864 break; 942 break;
865 943
866 case Bforward_line: 944 case Bforward_line:
867 /* This was wrong! --jwz */
868 TOP = Fforward_line (TOP); 945 TOP = Fforward_line (TOP);
869 break; 946 break;
870 947
871 case Bchar_syntax: 948 case Bchar_syntax:
872 CHECK_NUMBER (TOP, 0); 949 CHECK_NUMBER (TOP, 0);
878 TOP = Fbuffer_substring (TOP, v1); 955 TOP = Fbuffer_substring (TOP, v1);
879 break; 956 break;
880 957
881 case Bdelete_region: 958 case Bdelete_region:
882 v1 = POP; 959 v1 = POP;
883 /* This had args in the wrong order. -- jwz */
884 TOP = Fdelete_region (TOP, v1); 960 TOP = Fdelete_region (TOP, v1);
885 break; 961 break;
886 962
887 case Bnarrow_to_region: 963 case Bnarrow_to_region:
888 v1 = POP; 964 v1 = POP;
889 /* This had args in the wrong order. -- jwz */
890 TOP = Fnarrow_to_region (TOP, v1); 965 TOP = Fnarrow_to_region (TOP, v1);
891 break; 966 break;
892 967
893 case Bwiden: 968 case Bwiden:
894 PUSH (Fwiden ()); 969 PUSH (Fwiden ());
895 break; 970 break;
896 971
972 case Bend_of_line:
973 TOP = Fend_of_line (TOP);
974 break;
975
976 case Bset_marker:
977 v1 = POP;
978 v2 = POP;
979 TOP = Fset_marker (TOP, v2, v1);
980 break;
981
982 case Bmatch_beginning:
983 TOP = Fmatch_beginning (TOP);
984 break;
985
986 case Bmatch_end:
987 TOP = Fmatch_end (TOP);
988 break;
989
990 case Bupcase:
991 TOP = Fupcase (TOP);
992 break;
993
994 case Bdowncase:
995 TOP = Fdowncase (TOP);
996 break;
997
897 case Bstringeqlsign: 998 case Bstringeqlsign:
898 v1 = POP; 999 v1 = POP;
899 /* This had args in the wrong order. -- jwz */
900 TOP = Fstring_equal (TOP, v1); 1000 TOP = Fstring_equal (TOP, v1);
901 break; 1001 break;
902 1002
903 case Bstringlss: 1003 case Bstringlss:
904 v1 = POP; 1004 v1 = POP;
905 /* This had args in the wrong order. -- jwz */
906 TOP = Fstring_lessp (TOP, v1); 1005 TOP = Fstring_lessp (TOP, v1);
907 break; 1006 break;
908 1007
909 case Bequal: 1008 case Bequal:
910 v1 = POP; 1009 v1 = POP;
911 /* This had args in the wrong order. -- jwz */
912 TOP = Fequal (TOP, v1); 1010 TOP = Fequal (TOP, v1);
913 break; 1011 break;
914 1012
915 case Bnthcdr: 1013 case Bnthcdr:
916 v1 = POP; 1014 v1 = POP;
917 /* This had args in the wrong order. -- jwz */
918 TOP = Fnthcdr (TOP, v1); 1015 TOP = Fnthcdr (TOP, v1);
919 break; 1016 break;
920 1017
921 case Belt: 1018 case Belt:
922 if (XTYPE (TOP) == Lisp_Cons) 1019 if (XTYPE (TOP) == Lisp_Cons)
930 TOP = Felt (TOP, v1); 1027 TOP = Felt (TOP, v1);
931 break; 1028 break;
932 1029
933 case Bmember: 1030 case Bmember:
934 v1 = POP; 1031 v1 = POP;
935 /* This had args in the wrong order. -- jwz */
936 TOP = Fmember (TOP, v1); 1032 TOP = Fmember (TOP, v1);
937 break; 1033 break;
938 1034
939 case Bassq: 1035 case Bassq:
940 v1 = POP; 1036 v1 = POP;
941 /* This had args in the wrong order. -- jwz */
942 TOP = Fassq (TOP, v1); 1037 TOP = Fassq (TOP, v1);
943 break; 1038 break;
944 1039
945 case Bnreverse: 1040 case Bnreverse:
946 TOP = Fnreverse (TOP); 1041 TOP = Fnreverse (TOP);
947 break; 1042 break;
948 1043
949 case Bsetcar: 1044 case Bsetcar:
950 v1 = POP; 1045 v1 = POP;
951 /* This had args in the wrong order. -- jwz */
952 TOP = Fsetcar (TOP, v1); 1046 TOP = Fsetcar (TOP, v1);
953 break; 1047 break;
954 1048
955 case Bsetcdr: 1049 case Bsetcdr:
956 v1 = POP; 1050 v1 = POP;
957 /* This had args in the wrong order. -- jwz */
958 TOP = Fsetcdr (TOP, v1); 1051 TOP = Fsetcdr (TOP, v1);
959 break; 1052 break;
960 1053
961 case Bcar_safe: 1054 case Bcar_safe:
962 v1 = TOP; 1055 v1 = TOP;
1038 "a vector of vectors which holds a histogram of byte-code usage."); 1131 "a vector of vectors which holds a histogram of byte-code usage.");
1039 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, ""); 1132 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, "");
1040 1133
1041 byte_metering_on = 0; 1134 byte_metering_on = 0;
1042 Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0)); 1135 Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0));
1043 1136 staticpro (&Qbyte_code_meter);
1044 { 1137 {
1045 int i = 256; 1138 int i = 256;
1046 while (i--) 1139 while (i--)
1047 XVECTOR(Vbyte_code_meter)->contents[i] = 1140 XVECTOR(Vbyte_code_meter)->contents[i] =
1048 Fmake_vector(make_number(256), make_number(0)); 1141 Fmake_vector(make_number(256), make_number(0));