Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 859a2309aef8
children 538048ae2ab8
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
17 along with XEmacs; see the file COPYING. If not, write to 17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */ 19 Boston, MA 02111-1307, USA. */
20 20
21 /* Synched up with: Mule 2.0, FSF 19.30. */ 21 /* Synched up with: Mule 2.0, FSF 19.30. */
22
23 /* This file has been Mule-ized. */
24
22 25
23 /* Authorship: 26 /* Authorship:
24 27
25 FSF: long ago. 28 FSF: long ago.
26 29
35 o added metering support. 38 o added metering support.
36 39
37 by Hallvard: 40 by Hallvard:
38 o added relative jump instructions; 41 o added relative jump instructions;
39 o all conditionals now only do QUIT if they jump. 42 o all conditionals now only do QUIT if they jump.
43
44 Ben Wing: some changes for Mule, June 1995.
40 */ 45 */
41 46
42 #include <config.h> 47 #include <config.h>
43 #include "lisp.h" 48 #include "lisp.h"
44 #include "buffer.h" 49 #include "buffer.h"
49 * debugging the byte compiler...) Somewhat surprisingly, defining this 54 * debugging the byte compiler...) Somewhat surprisingly, defining this
50 * makes Fbyte_code about 8% slower. 55 * makes Fbyte_code about 8% slower.
51 * 56 *
52 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 57 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
53 */ 58 */
54 /* #define BYTE_CODE_SAFE */ 59 #define BYTE_CODE_SAFE
55 /* #define BYTE_CODE_METER */ 60 /* #define BYTE_CODE_METER */
56 61
57 62
58 #ifdef BYTE_CODE_METER 63 #ifdef BYTE_CODE_METER
59 64
94 #define Bnth 070 99 #define Bnth 070
95 #define Bsymbolp 071 100 #define Bsymbolp 071
96 #define Bconsp 072 101 #define Bconsp 072
97 #define Bstringp 073 102 #define Bstringp 073
98 #define Blistp 074 103 #define Blistp 074
99 #define Beq 075 104 #define Bold_eq 075
100 #define Bmemq 076 105 #define Bold_memq 076
101 #define Bnot 077 106 #define Bnot 077
102 #define Bcar 0100 107 #define Bcar 0100
103 #define Bcdr 0101 108 #define Bcdr 0101
104 #define Bcons 0102 109 #define Bcons 0102
105 #define Blist1 0103 110 #define Blist1 0103
131 #define Bmax 0135 136 #define Bmax 0135
132 #define Bmin 0136 137 #define Bmin 0136
133 #define Bmult 0137 138 #define Bmult 0137
134 139
135 #define Bpoint 0140 140 #define Bpoint 0140
136 #define Bmark 0141 /* no longer generated as of v18 */ 141 #define Beq 0141 /* was Bmark, but no longer generated as of v18 */
137 #define Bgoto_char 0142 142 #define Bgoto_char 0142
138 #define Binsert 0143 143 #define Binsert 0143
139 #define Bpoint_max 0144 144 #define Bpoint_max 0144
140 #define Bpoint_min 0145 145 #define Bpoint_min 0145
141 #define Bchar_after 0146 146 #define Bchar_after 0146
142 #define Bfollowing_char 0147 147 #define Bfollowing_char 0147
143 #define Bpreceding_char 0150 148 #define Bpreceding_char 0150
144 #define Bcurrent_column 0151 149 #define Bcurrent_column 0151
145 #define Bindent_to 0152 150 #define Bindent_to 0152
146 #define Bscan_buffer 0153 /* No longer generated as of v18 */ 151 #define Bequal 0153 /* was Bscan_buffer, but no longer generated as of v18 */
147 #define Beolp 0154 152 #define Beolp 0154
148 #define Beobp 0155 153 #define Beobp 0155
149 #define Bbolp 0156 154 #define Bbolp 0156
150 #define Bbobp 0157 155 #define Bbobp 0157
151 #define Bcurrent_buffer 0160 156 #define Bcurrent_buffer 0160
152 #define Bset_buffer 0161 157 #define Bset_buffer 0161
153 #define Bread_char 0162 /* No longer generated as of v19 */ 158 #define Bread_char 0162 /* No longer generated as of v19 */
154 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ 159 #define Bmemq 0163 /* was Bset_mark, but no longer generated as of v18 */
155 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ 160 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
156 161
157 #define Bforward_char 0165 162 #define Bforward_char 0165
158 #define Bforward_word 0166 163 #define Bforward_word 0166
159 #define Bskip_chars_forward 0167 164 #define Bskip_chars_forward 0167
194 #define Bupcase 0226 199 #define Bupcase 0226
195 #define Bdowncase 0227 200 #define Bdowncase 0227
196 201
197 #define Bstringeqlsign 0230 202 #define Bstringeqlsign 0230
198 #define Bstringlss 0231 203 #define Bstringlss 0231
199 #define Bequal 0232 204 #define Bold_equal 0232
200 #define Bnthcdr 0233 205 #define Bnthcdr 0233
201 #define Belt 0234 206 #define Belt 0234
202 #define Bmember 0235 207 #define Bold_member 0235
203 #define Bassq 0236 208 #define Bold_assq 0236
204 #define Bnreverse 0237 209 #define Bnreverse 0237
205 #define Bsetcar 0240 210 #define Bsetcar 0240
206 #define Bsetcdr 0241 211 #define Bsetcdr 0241
207 #define Bcar_safe 0242 212 #define Bcar_safe 0242
208 #define Bcdr_safe 0243 213 #define Bcdr_safe 0243
219 #define BRgotoifnonnilelsepop 0256 224 #define BRgotoifnonnilelsepop 0256
220 225
221 #define BlistN 0257 226 #define BlistN 0257
222 #define BconcatN 0260 227 #define BconcatN 0260
223 #define BinsertN 0261 228 #define BinsertN 0261
229 #define Bmember 0266 /* new in v20 */
230 #define Bassq 0267 /* new in v20 */
224 231
225 #define Bconstant 0300 232 #define Bconstant 0300
226 #define CONSTANTLIM 0100 233 #define CONSTANTLIM 0100
227 234
228 /* Fetch the next byte from the bytecode stream */ 235 /* Fetch the next byte from the bytecode stream */
229 236
230 #ifdef V20_SLOW_WAY
231 #define FETCH (massaged_code[pc++]) 237 #define FETCH (massaged_code[pc++])
232 #else /* !V20_SLOW_WAY */
233 #define FETCH *pc++
234 #endif /* !V20_SLOW_WAY */
235 238
236 /* Fetch two bytes from the bytecode stream 239 /* Fetch two bytes from the bytecode stream
237 and make a 16-bit number out of them */ 240 and make a 16-bit number out of them */
238 241
239 #define FETCH2 (op = FETCH, op + (FETCH << 8)) 242 #define FETCH2 (op = FETCH, op + (FETCH << 8))
272 #ifdef BYTE_CODE_METER 275 #ifdef BYTE_CODE_METER
273 int this_op = 0; 276 int this_op = 0;
274 int prev_op; 277 int prev_op;
275 #endif 278 #endif
276 REGISTER int op; 279 REGISTER int op;
277 #ifdef V20_SLOW_WAY
278 int pc; 280 int pc;
279 #else /* !V20_SLOW_WAY */
280 REGISTER Bufbyte *pc;
281 #endif /* !V20_SLOW_WAY */
282 Lisp_Object *stack; 281 Lisp_Object *stack;
283 REGISTER Lisp_Object *stackp; 282 REGISTER Lisp_Object *stackp;
284 Lisp_Object *stacke; 283 Lisp_Object *stacke;
285 REGISTER Lisp_Object v1, v2; 284 REGISTER Lisp_Object v1, v2;
286 REGISTER Lisp_Object *vectorp = vector_data (XVECTOR (vector)); 285 REGISTER Lisp_Object *vectorp = vector_data (XVECTOR (vector));
287 #ifdef BYTE_CODE_SAFE 286 #ifdef BYTE_CODE_SAFE
288 REGISTER int const_length = vector_length (XVECTOR (vector)); 287 REGISTER int const_length = vector_length (XVECTOR (vector));
289 #endif 288 #endif
290 #ifdef V20_SLOW_WAY
291 REGISTER Emchar *massaged_code; 289 REGISTER Emchar *massaged_code;
292 int massaged_code_len; 290 int massaged_code_len;
293 #else /* !V20_SLOW_WAY */
294 /* Cached address of beginning of string, valid if BYTESTR data not
295 relocated. */
296 REGISTER Bufbyte *strbeg;
297 REGISTER struct Lisp_String *detagged_string;
298 #endif /* !V20_SLOW_WAY */
299 291
300 CHECK_STRING (bytestr); 292 CHECK_STRING (bytestr);
301 if (!VECTORP (vector)) 293 if (!VECTORP (vector))
302 vector = wrong_type_argument (Qvectorp, vector); 294 vector = wrong_type_argument (Qvectorp, vector);
303 CHECK_NATNUM (maxdepth); 295 CHECK_NATNUM (maxdepth);
309 301
310 --stackp; 302 --stackp;
311 stack = stackp; 303 stack = stackp;
312 stacke = stackp + XINT (maxdepth); 304 stacke = stackp + XINT (maxdepth);
313 305
314 #ifdef V20_SLOW_WAY
315 /* Initialize the pc-register and convert the string into a fixed-width 306 /* Initialize the pc-register and convert the string into a fixed-width
316 format for easier processing. */ 307 format for easier processing. */
317 massaged_code = 308 massaged_code =
318 (Emchar *) alloca (sizeof (Emchar) * 309 (Emchar *) alloca (sizeof (Emchar) *
319 (1 + string_char_length (XSTRING (bytestr)))); 310 (1 + string_char_length (XSTRING (bytestr))));
321 convert_bufbyte_string_into_emchar_string (XSTRING_DATA (bytestr), 312 convert_bufbyte_string_into_emchar_string (XSTRING_DATA (bytestr),
322 XSTRING_LENGTH (bytestr), 313 XSTRING_LENGTH (bytestr),
323 massaged_code); 314 massaged_code);
324 massaged_code[massaged_code_len] = 0; 315 massaged_code[massaged_code_len] = 0;
325 pc = 0; 316 pc = 0;
326 #else /* !V20_SLOW_WAY */ 317
327 /* Initialize the pc-pointer by fetching from the string. */
328 detagged_string = XSTRING (bytestr);
329 pc = string_data (detagged_string);
330 strbeg = pc;
331 #endif /* !V20_SLOW_WAY */
332
333 while (1) 318 while (1)
334 { 319 {
335 #ifdef BYTE_CODE_SAFE 320 #ifdef BYTE_CODE_SAFE
336 if (stackp > stacke) 321 if (stackp > stacke)
337 error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", 322 error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
338 #ifdef V20_SLOW_WAY
339 pc, stacke - stackp); 323 pc, stacke - stackp);
340 #else /* !V20_SLOW_WAY */
341 pc - string_data (detagged_string), stacke - stackp);
342 #endif /* !V20_SLOW_WAY */
343 if (stackp < stack) 324 if (stackp < stack)
344 error ("Byte code stack underflow (byte compiler bug), pc %d", 325 error ("Byte code stack underflow (byte compiler bug), pc %d",
345 #ifdef V20_SLOW_WAY
346 pc); 326 pc);
347 #else /* !V20_SLOW_WAY */
348 pc - string_data (detagged_string));
349 #endif /* !V20_SLOW_WAY */
350 #endif 327 #endif
351
352 #ifndef V20_SLOW_WAY
353 if (strbeg != string_data (detagged_string))
354 {
355 pc = pc - strbeg + string_data (detagged_string);
356 strbeg = string_data (detagged_string);
357 }
358 #endif /* !V20_SLOW_WAY */
359 328
360 #ifdef BYTE_CODE_METER 329 #ifdef BYTE_CODE_METER
361 prev_op = this_op; 330 prev_op = this_op;
362 this_op = op = FETCH; 331 this_op = op = FETCH;
363 METER_CODE (prev_op, op); 332 METER_CODE (prev_op, op);
471 break; 440 break;
472 441
473 case Bgoto: 442 case Bgoto:
474 QUIT; 443 QUIT;
475 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ 444 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
476 #ifdef V20_SLOW_WAY
477 pc = op; 445 pc = op;
478 #else /* !V20_SLOW_WAY */
479 pc = string_data (detagged_string) + op;
480 #endif /* !V20_SLOW_WAY */
481 break; 446 break;
482 447
483 case Bgotoifnil: 448 case Bgotoifnil:
484 op = FETCH2; 449 op = FETCH2;
485 if (NILP (POP)) 450 if (NILP (POP))
486 { 451 {
487 QUIT; 452 QUIT;
488 #ifdef V20_SLOW_WAY
489 pc = op; 453 pc = op;
490 #else /* !V20_SLOW_WAY */
491 pc = string_data (detagged_string) + op;
492 #endif /* !V20_SLOW_WAY */
493 } 454 }
494 break; 455 break;
495 456
496 case Bgotoifnonnil: 457 case Bgotoifnonnil:
497 op = FETCH2; 458 op = FETCH2;
498 if (!NILP (POP)) 459 if (!NILP (POP))
499 { 460 {
500 QUIT; 461 QUIT;
501 #ifdef V20_SLOW_WAY
502 pc = op; 462 pc = op;
503 #else /* !V20_SLOW_WAY */
504 pc = string_data (detagged_string) + op;
505 #endif /* !V20_SLOW_WAY */
506 } 463 }
507 break; 464 break;
508 465
509 case Bgotoifnilelsepop: 466 case Bgotoifnilelsepop:
510 op = FETCH2; 467 op = FETCH2;
511 if (NILP (TOP)) 468 if (NILP (TOP))
512 { 469 {
513 QUIT; 470 QUIT;
514 #ifdef V20_SLOW_WAY
515 pc = op; 471 pc = op;
516 #else /* !V20_SLOW_WAY */
517 pc = string_data (detagged_string) + op;
518 #endif /* !V20_SLOW_WAY */
519 } 472 }
520 else DISCARD (1); 473 else DISCARD (1);
521 break; 474 break;
522 475
523 case Bgotoifnonnilelsepop: 476 case Bgotoifnonnilelsepop:
524 op = FETCH2; 477 op = FETCH2;
525 if (!NILP (TOP)) 478 if (!NILP (TOP))
526 { 479 {
527 QUIT; 480 QUIT;
528 #ifdef V20_SLOW_WAY
529 pc = op; 481 pc = op;
530 #else /* !V20_SLOW_WAY */
531 pc = string_data (detagged_string) + op;
532 #endif /* !V20_SLOW_WAY */
533 } 482 }
534 else DISCARD (1); 483 else DISCARD (1);
535 break; 484 break;
536 485
537 case BRgoto: 486 case BRgoto:
538 QUIT; 487 QUIT;
539 #ifdef V20_SLOW_WAY
540 pc += massaged_code[pc] - 127; 488 pc += massaged_code[pc] - 127;
541 #else /* !V20_SLOW_WAY */
542 /* pc += *pc - 127; */
543 pc = (unsigned char *) ((unsigned long) pc + *pc - 127);
544 #endif /* !V20_SLOW_WAY */
545 break; 489 break;
546 490
547 case BRgotoifnil: 491 case BRgotoifnil:
548 if (NILP (POP)) 492 if (NILP (POP))
549 { 493 {
550 QUIT; 494 QUIT;
551 #ifdef V20_SLOW_WAY
552 pc += massaged_code[pc] - 128; 495 pc += massaged_code[pc] - 128;
553 #else /* !V20_SLOW_WAY */
554 /* pc += *pc - 128; */
555 pc = (unsigned char *) ((unsigned long) pc + *pc - 128);
556 #endif /* !V20_SLOW_WAY */
557 } 496 }
558 pc++; 497 pc++;
559 break; 498 break;
560 499
561 case BRgotoifnonnil: 500 case BRgotoifnonnil:
562 if (!NILP (POP)) 501 if (!NILP (POP))
563 { 502 {
564 QUIT; 503 QUIT;
565 #ifdef V20_SLOW_WAY
566 pc += massaged_code[pc] - 128; 504 pc += massaged_code[pc] - 128;
567 #else /* !V20_SLOW_WAY */
568 /* pc += *pc - 128; */
569 pc = (unsigned char *) ((unsigned long) pc + *pc - 128);
570 #endif /* !V20_SLOW_WAY */
571 } 505 }
572 pc++; 506 pc++;
573 break; 507 break;
574 508
575 case BRgotoifnilelsepop: 509 case BRgotoifnilelsepop:
576 op = FETCH; 510 op = FETCH;
577 if (NILP (TOP)) 511 if (NILP (TOP))
578 { 512 {
579 QUIT; 513 QUIT;
580 #ifdef V20_SLOW_WAY
581 pc += op - 128; 514 pc += op - 128;
582 #else /* !V20_SLOW_WAY */
583 /* pc += op - 128; */
584 pc = (unsigned char *) ((unsigned long) pc + op - 128);
585 #endif /* !V20_SLOW_WAY */
586 } 515 }
587 else DISCARD (1); 516 else DISCARD (1);
588 break; 517 break;
589 518
590 case BRgotoifnonnilelsepop: 519 case BRgotoifnonnilelsepop:
591 op = FETCH; 520 op = FETCH;
592 if (!NILP (TOP)) 521 if (!NILP (TOP))
593 { 522 {
594 QUIT; 523 QUIT;
595 #ifdef V20_SLOW_WAY
596 pc += op - 128; 524 pc += op - 128;
597 #else /* !V20_SLOW_WAY */
598 /* pc += op - 128; */
599 pc = (unsigned char *) ((unsigned long) pc + op - 128);
600 #endif /* !V20_SLOW_WAY */
601 } 525 }
602 else DISCARD (1); 526 else DISCARD (1);
603 break; 527 break;
604 528
605 case Breturn: 529 case Breturn:
703 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; 627 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
704 break; 628 break;
705 629
706 case Beq: 630 case Beq:
707 v1 = POP; 631 v1 = POP;
632 TOP = ((EQ_WITH_EBOLA_NOTICE (v1, TOP)) ? Qt : Qnil);
633 break;
634
635 case Bold_eq:
636 v1 = POP;
708 TOP = ((HACKEQ_UNSAFE (v1, TOP)) ? Qt : Qnil); 637 TOP = ((HACKEQ_UNSAFE (v1, TOP)) ? Qt : Qnil);
709 break; 638 break;
710 639
711 case Bmemq: 640 case Bmemq:
712 v1 = POP; 641 v1 = POP;
713 TOP = Fmemq (TOP, v1); 642 TOP = Fmemq (TOP, v1);
643 break;
644
645 case Bold_memq:
646 v1 = POP;
647 TOP = Fold_memq (TOP, v1);
714 break; 648 break;
715 649
716 case Bnot: 650 case Bnot:
717 TOP = NILP (TOP) ? Qt : Qnil; 651 TOP = NILP (TOP) ? Qt : Qnil;
718 break; 652 break;
1006 case Bset_buffer: 940 case Bset_buffer:
1007 TOP = Fset_buffer (TOP); 941 TOP = Fset_buffer (TOP);
1008 break; 942 break;
1009 943
1010 case Bread_char: 944 case Bread_char:
1011 PUSH (call0 (Qread_char)); 945 error ("read-char is an obsolete byte code");
1012 QUIT;
1013 break; 946 break;
1014 947
1015 case Binteractive_p: 948 case Binteractive_p:
1016 PUSH (Finteractive_p ()); 949 PUSH (Finteractive_p ());
1017 break; 950 break;
1040 973
1041 case Bchar_syntax: 974 case Bchar_syntax:
1042 CHECK_CHAR_COERCE_INT (TOP); 975 CHECK_CHAR_COERCE_INT (TOP);
1043 TOP = make_char (syntax_code_spec 976 TOP = make_char (syntax_code_spec
1044 [(int) SYNTAX 977 [(int) SYNTAX
1045 (current_buffer->syntax_table, 978 (XCHAR_TABLE
1046 XCHAR (TOP))]); 979 (current_buffer->mirror_syntax_table),
980 XCHAR (TOP))]);
1047 break; 981 break;
1048 982
1049 case Bbuffer_substring: 983 case Bbuffer_substring:
1050 v1 = POP; 984 v1 = POP;
1051 TOP = Fbuffer_substring (TOP, v1, Fcurrent_buffer ()); 985 TOP = Fbuffer_substring (TOP, v1, Fcurrent_buffer ());
1102 break; 1036 break;
1103 1037
1104 case Bequal: 1038 case Bequal:
1105 v1 = POP; 1039 v1 = POP;
1106 TOP = Fequal (TOP, v1); 1040 TOP = Fequal (TOP, v1);
1041 break;
1042
1043 case Bold_equal:
1044 v1 = POP;
1045 TOP = Fold_equal (TOP, v1);
1107 break; 1046 break;
1108 1047
1109 case Bnthcdr: 1048 case Bnthcdr:
1110 v1 = POP; 1049 v1 = POP;
1111 TOP = Fnthcdr (TOP, v1); 1050 TOP = Fnthcdr (TOP, v1);
1130 case Bmember: 1069 case Bmember:
1131 v1 = POP; 1070 v1 = POP;
1132 TOP = Fmember (TOP, v1); 1071 TOP = Fmember (TOP, v1);
1133 break; 1072 break;
1134 1073
1074 case Bold_member:
1075 v1 = POP;
1076 TOP = Fold_member (TOP, v1);
1077 break;
1078
1135 case Bassq: 1079 case Bassq:
1136 v1 = POP; 1080 v1 = POP;
1137 TOP = Fassq (TOP, v1); 1081 TOP = Fassq (TOP, v1);
1082 break;
1083
1084 case Bold_assq:
1085 v1 = POP;
1086 TOP = Fold_assq (TOP, v1);
1138 break; 1087 break;
1139 1088
1140 case Bnreverse: 1089 case Bnreverse:
1141 TOP = Fnreverse (TOP); 1090 TOP = Fnreverse (TOP);
1142 break; 1091 break;
1177 break; 1126 break;
1178 1127
1179 case Bintegerp: 1128 case Bintegerp:
1180 TOP = ((INTP (TOP)) ? Qt : Qnil); 1129 TOP = ((INTP (TOP)) ? Qt : Qnil);
1181 break; 1130 break;
1182
1183 #ifdef BYTE_CODE_SAFE
1184 case Bset_mark:
1185 error ("set-mark is an obsolete bytecode");
1186 break;
1187 case Bscan_buffer:
1188 error ("scan-buffer is an obsolete bytecode");
1189 break;
1190 case Bmark:
1191 error ("mark is an obsolete bytecode");
1192 break;
1193 #endif
1194 1131
1195 default: 1132 default:
1196 #ifdef BYTE_CODE_SAFE 1133 #ifdef BYTE_CODE_SAFE
1197 if (op < Bconstant) 1134 if (op < Bconstant)
1198 error ("unknown bytecode %d (byte compiler bug)", op); 1135 error ("unknown bytecode %d (byte compiler bug)", op);