Mercurial > emacs
annotate src/bytecode.c @ 24841:d2d412758428
(clear_cached_bitmap_slots): Remove.
(get_bitmap_with_cache): Check if CreateBitmap failed.
Adjust cache size dynamically so cache is never larger than the
system limit of GDI resources.
Do cache clearing inline. Move global variables to local scope.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Sun, 13 Jun 1999 17:49:12 +0000 |
parents | c69d612b0819 |
children | a14111a2a100 |
rev | line source |
---|---|
310 | 1 /* Execution of byte code produced by bytecomp.el. |
2961 | 2 Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc. |
310 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
8 the Free Software Foundation; either version 2, or (at your option) |
310 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
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 | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14061
diff
changeset
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14061
diff
changeset
|
19 Boston, MA 02111-1307, USA. |
310 | 20 |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
21 hacked on by jwz@lucid.com 17-jun-91 |
310 | 22 o added a compile-time switch to turn on simple sanity checking; |
23 o put back the obsolete byte-codes for error-detection; | |
24 o added a new instruction, unbind_all, which I will use for | |
25 tail-recursion elimination; | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
26 o made temp_output_buffer_show be called with the right number |
310 | 27 of args; |
28 o made the new bytecodes be called with args in the right order; | |
29 o added metering support. | |
30 | |
31 by Hallvard: | |
435
43e88c4db330
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
396
diff
changeset
|
32 o added relative jump instructions; |
310 | 33 o all conditionals now only do QUIT if they jump. |
34 */ | |
35 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
2961
diff
changeset
|
36 #include <config.h> |
310 | 37 #include "lisp.h" |
38 #include "buffer.h" | |
23715 | 39 #include "charset.h" |
310 | 40 #include "syntax.h" |
41 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
42 /* |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
43 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
44 * debugging the byte compiler...) |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
45 * |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
46 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. |
310 | 47 */ |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
48 /* #define BYTE_CODE_SAFE */ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
49 /* #define BYTE_CODE_METER */ |
310 | 50 |
51 | |
52 #ifdef BYTE_CODE_METER | |
53 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
54 Lisp_Object Vbyte_code_meter, Qbyte_code_meter; |
310 | 55 int byte_metering_on; |
56 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
57 #define METER_2(code1, code2) \ |
310 | 58 XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ |
59 ->contents[(code2)]) | |
60 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
61 #define METER_1(code) METER_2 (0, (code)) |
310 | 62 |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
63 #define METER_CODE(last_code, this_code) \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
64 { \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
65 if (byte_metering_on) \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
66 { \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
67 if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
68 METER_1 (this_code)++; \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
69 if (last_code \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
70 && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
71 METER_2 (last_code, this_code)++; \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
72 } \ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
73 } |
310 | 74 |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
75 #else /* no BYTE_CODE_METER */ |
310 | 76 |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
77 #define METER_CODE(last_code, this_code) |
310 | 78 |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
79 #endif /* no BYTE_CODE_METER */ |
310 | 80 |
81 | |
82 Lisp_Object Qbytecode; | |
83 | |
84 /* Byte codes: */ | |
85 | |
86 #define Bvarref 010 | |
87 #define Bvarset 020 | |
88 #define Bvarbind 030 | |
89 #define Bcall 040 | |
90 #define Bunbind 050 | |
91 | |
92 #define Bnth 070 | |
93 #define Bsymbolp 071 | |
94 #define Bconsp 072 | |
95 #define Bstringp 073 | |
96 #define Blistp 074 | |
97 #define Beq 075 | |
98 #define Bmemq 076 | |
99 #define Bnot 077 | |
100 #define Bcar 0100 | |
101 #define Bcdr 0101 | |
102 #define Bcons 0102 | |
103 #define Blist1 0103 | |
104 #define Blist2 0104 | |
105 #define Blist3 0105 | |
106 #define Blist4 0106 | |
107 #define Blength 0107 | |
108 #define Baref 0110 | |
109 #define Baset 0111 | |
110 #define Bsymbol_value 0112 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
111 #define Bsymbol_function 0113 |
310 | 112 #define Bset 0114 |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
113 #define Bfset 0115 |
310 | 114 #define Bget 0116 |
115 #define Bsubstring 0117 | |
116 #define Bconcat2 0120 | |
117 #define Bconcat3 0121 | |
118 #define Bconcat4 0122 | |
119 #define Bsub1 0123 | |
120 #define Badd1 0124 | |
121 #define Beqlsign 0125 | |
122 #define Bgtr 0126 | |
123 #define Blss 0127 | |
124 #define Bleq 0130 | |
125 #define Bgeq 0131 | |
126 #define Bdiff 0132 | |
127 #define Bnegate 0133 | |
128 #define Bplus 0134 | |
129 #define Bmax 0135 | |
130 #define Bmin 0136 | |
131 #define Bmult 0137 | |
132 | |
133 #define Bpoint 0140 | |
16292
86408ea93da6
(Bsave_current_buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16039
diff
changeset
|
134 /* Was Bmark in v17. */ |
86408ea93da6
(Bsave_current_buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16039
diff
changeset
|
135 #define Bsave_current_buffer 0141 |
310 | 136 #define Bgoto_char 0142 |
137 #define Binsert 0143 | |
138 #define Bpoint_max 0144 | |
139 #define Bpoint_min 0145 | |
140 #define Bchar_after 0146 | |
141 #define Bfollowing_char 0147 | |
142 #define Bpreceding_char 0150 | |
143 #define Bcurrent_column 0151 | |
144 #define Bindent_to 0152 | |
145 #define Bscan_buffer 0153 /* No longer generated as of v18 */ | |
146 #define Beolp 0154 | |
147 #define Beobp 0155 | |
148 #define Bbolp 0156 | |
149 #define Bbobp 0157 | |
150 #define Bcurrent_buffer 0160 | |
151 #define Bset_buffer 0161 | |
18245 | 152 #define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
153 #define Bread_char 0162 /* No longer generated as of v19 */ |
310 | 154 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ |
155 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ | |
156 | |
157 #define Bforward_char 0165 | |
158 #define Bforward_word 0166 | |
159 #define Bskip_chars_forward 0167 | |
160 #define Bskip_chars_backward 0170 | |
161 #define Bforward_line 0171 | |
162 #define Bchar_syntax 0172 | |
163 #define Bbuffer_substring 0173 | |
164 #define Bdelete_region 0174 | |
165 #define Bnarrow_to_region 0175 | |
166 #define Bwiden 0176 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
167 #define Bend_of_line 0177 |
310 | 168 |
169 #define Bconstant2 0201 | |
170 #define Bgoto 0202 | |
171 #define Bgotoifnil 0203 | |
172 #define Bgotoifnonnil 0204 | |
173 #define Bgotoifnilelsepop 0205 | |
174 #define Bgotoifnonnilelsepop 0206 | |
175 #define Breturn 0207 | |
176 #define Bdiscard 0210 | |
177 #define Bdup 0211 | |
178 | |
179 #define Bsave_excursion 0212 | |
180 #define Bsave_window_excursion 0213 | |
181 #define Bsave_restriction 0214 | |
182 #define Bcatch 0215 | |
183 | |
184 #define Bunwind_protect 0216 | |
185 #define Bcondition_case 0217 | |
186 #define Btemp_output_buffer_setup 0220 | |
187 #define Btemp_output_buffer_show 0221 | |
188 | |
189 #define Bunbind_all 0222 | |
190 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
191 #define Bset_marker 0223 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
192 #define Bmatch_beginning 0224 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
193 #define Bmatch_end 0225 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
194 #define Bupcase 0226 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
195 #define Bdowncase 0227 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
196 |
310 | 197 #define Bstringeqlsign 0230 |
198 #define Bstringlss 0231 | |
199 #define Bequal 0232 | |
200 #define Bnthcdr 0233 | |
201 #define Belt 0234 | |
202 #define Bmember 0235 | |
203 #define Bassq 0236 | |
204 #define Bnreverse 0237 | |
205 #define Bsetcar 0240 | |
206 #define Bsetcdr 0241 | |
207 #define Bcar_safe 0242 | |
208 #define Bcdr_safe 0243 | |
209 #define Bnconc 0244 | |
210 #define Bquo 0245 | |
211 #define Brem 0246 | |
212 #define Bnumberp 0247 | |
213 #define Bintegerp 0250 | |
214 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
215 #define BRgoto 0252 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
216 #define BRgotoifnil 0253 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
217 #define BRgotoifnonnil 0254 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
218 #define BRgotoifnilelsepop 0255 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
219 #define BRgotoifnonnilelsepop 0256 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
220 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
221 #define BlistN 0257 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
222 #define BconcatN 0260 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
223 #define BinsertN 0261 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
224 |
310 | 225 #define Bconstant 0300 |
226 #define CONSTANTLIM 0100 | |
227 | |
228 /* Fetch the next byte from the bytecode stream */ | |
229 | |
230 #define FETCH *pc++ | |
231 | |
232 /* Fetch two bytes from the bytecode stream | |
233 and make a 16-bit number out of them */ | |
234 | |
235 #define FETCH2 (op = FETCH, op + (FETCH << 8)) | |
236 | |
237 /* Push x onto the execution stack. */ | |
238 | |
239 /* This used to be #define PUSH(x) (*++stackp = (x)) | |
240 This oddity is necessary because Alliant can't be bothered to | |
241 compile the preincrement operator properly, as of 4/91. -JimB */ | |
242 #define PUSH(x) (stackp++, *stackp = (x)) | |
243 | |
244 /* Pop a value off the execution stack. */ | |
245 | |
246 #define POP (*stackp--) | |
247 | |
248 /* Discard n values from the execution stack. */ | |
249 | |
250 #define DISCARD(n) (stackp -= (n)) | |
251 | |
252 /* Get the value which is at the top of the execution stack, but don't pop it. */ | |
253 | |
254 #define TOP (*stackp) | |
255 | |
16628 | 256 /* Garbage collect if we have consed enough since the last time. |
257 We do this at every branch, to avoid loops that never GC. */ | |
258 | |
259 #define MAYBE_GC() \ | |
260 if (consing_since_gc > gc_cons_threshold) \ | |
16815
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
261 { \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
262 Fgarbage_collect (); \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
263 HANDLE_RELOCATION (); \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
264 } \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
265 else |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
266 |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
267 /* Relocate BYTESTR if there has been a GC recently. */ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
268 #define HANDLE_RELOCATION() \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
269 if (! EQ (string_saved, bytestr)) \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
270 { \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
271 pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data; \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
272 string_saved = bytestr; \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
273 } \ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
274 else |
16628 | 275 |
16784
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
276 /* Check for jumping out of range. */ |
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
277 #define CHECK_RANGE(ARG) \ |
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
278 if (ARG >= bytestr_length) abort () |
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
279 |
310 | 280 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, |
281 "Function used internally in byte-compiled code.\n\ | |
14061
bf43ef5a139c
(Fbyte_code): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
12575
diff
changeset
|
282 The first argument, BYTESTR, is a string of byte code;\n\ |
bf43ef5a139c
(Fbyte_code): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
12575
diff
changeset
|
283 the second, VECTOR, a vector of constants;\n\ |
bf43ef5a139c
(Fbyte_code): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
12575
diff
changeset
|
284 the third, MAXDEPTH, the maximum stack depth used in this function.\n\ |
310 | 285 If the third argument is incorrect, Emacs may crash.") |
286 (bytestr, vector, maxdepth) | |
287 Lisp_Object bytestr, vector, maxdepth; | |
288 { | |
289 struct gcpro gcpro1, gcpro2, gcpro3; | |
290 int count = specpdl_ptr - specpdl; | |
291 #ifdef BYTE_CODE_METER | |
292 int this_op = 0; | |
293 int prev_op; | |
294 #endif | |
295 register int op; | |
296 unsigned char *pc; | |
297 Lisp_Object *stack; | |
298 register Lisp_Object *stackp; | |
299 Lisp_Object *stacke; | |
300 register Lisp_Object v1, v2; | |
301 register Lisp_Object *vectorp = XVECTOR (vector)->contents; | |
302 #ifdef BYTE_CODE_SAFE | |
303 register int const_length = XVECTOR (vector)->size; | |
304 #endif | |
305 /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated. */ | |
306 Lisp_Object string_saved; | |
307 /* Cached address of beginning of string, | |
308 valid if BYTESTR equals STRING_SAVED. */ | |
309 register unsigned char *strbeg; | |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
20697
diff
changeset
|
310 int bytestr_length = STRING_BYTES (XSTRING (bytestr)); |
310 | 311 |
312 CHECK_STRING (bytestr, 0); | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
313 if (!VECTORP (vector)) |
310 | 314 vector = wrong_type_argument (Qvectorp, vector); |
315 CHECK_NUMBER (maxdepth, 2); | |
316 | |
317 stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object)); | |
318 bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object)); | |
319 GCPRO3 (bytestr, vector, *stackp); | |
320 gcpro3.nvars = XFASTINT (maxdepth); | |
321 | |
322 --stackp; | |
323 stack = stackp; | |
324 stacke = stackp + XFASTINT (maxdepth); | |
325 | |
326 /* Initialize the saved pc-pointer for fetching from the string. */ | |
327 string_saved = bytestr; | |
328 pc = XSTRING (string_saved)->data; | |
329 | |
330 while (1) | |
331 { | |
332 #ifdef BYTE_CODE_SAFE | |
333 if (stackp > stacke) | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
334 error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", |
310 | 335 pc - XSTRING (string_saved)->data, stacke - stackp); |
336 if (stackp < stack) | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
337 error ("Byte code stack underflow (byte compiler bug), pc %d", |
310 | 338 pc - XSTRING (string_saved)->data); |
339 #endif | |
340 | |
16815
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
341 /* Update BYTESTR if we had a garbage collection. */ |
9e0f59154164
(HANDLE_RELOCATION): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16784
diff
changeset
|
342 HANDLE_RELOCATION (); |
310 | 343 |
344 #ifdef BYTE_CODE_METER | |
345 prev_op = this_op; | |
346 this_op = op = FETCH; | |
347 METER_CODE (prev_op, op); | |
348 switch (op) | |
349 #else | |
350 switch (op = FETCH) | |
351 #endif | |
352 { | |
353 case Bvarref+6: | |
354 op = FETCH; | |
355 goto varref; | |
356 | |
357 case Bvarref+7: | |
358 op = FETCH2; | |
359 goto varref; | |
360 | |
361 case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3: | |
362 case Bvarref+4: case Bvarref+5: | |
363 op = op - Bvarref; | |
364 varref: | |
365 v1 = vectorp[op]; | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
366 if (!SYMBOLP (v1)) |
310 | 367 v2 = Fsymbol_value (v1); |
368 else | |
369 { | |
370 v2 = XSYMBOL (v1)->value; | |
9894
a541739a1ba8
(Fbyte_code): Special case for buffer-local objects is now handled by the more
Karl Heuer <kwzh@gnu.org>
parents:
9467
diff
changeset
|
371 if (MISCP (v2) || EQ (v2, Qunbound)) |
a541739a1ba8
(Fbyte_code): Special case for buffer-local objects is now handled by the more
Karl Heuer <kwzh@gnu.org>
parents:
9467
diff
changeset
|
372 v2 = Fsymbol_value (v1); |
310 | 373 } |
374 PUSH (v2); | |
375 break; | |
376 | |
377 case Bvarset+6: | |
378 op = FETCH; | |
379 goto varset; | |
380 | |
381 case Bvarset+7: | |
382 op = FETCH2; | |
383 goto varset; | |
384 | |
385 case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3: | |
386 case Bvarset+4: case Bvarset+5: | |
387 op -= Bvarset; | |
388 varset: | |
389 Fset (vectorp[op], POP); | |
390 break; | |
391 | |
392 case Bvarbind+6: | |
393 op = FETCH; | |
394 goto varbind; | |
395 | |
396 case Bvarbind+7: | |
397 op = FETCH2; | |
398 goto varbind; | |
399 | |
400 case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3: | |
401 case Bvarbind+4: case Bvarbind+5: | |
402 op -= Bvarbind; | |
403 varbind: | |
404 specbind (vectorp[op], POP); | |
405 break; | |
406 | |
407 case Bcall+6: | |
408 op = FETCH; | |
409 goto docall; | |
410 | |
411 case Bcall+7: | |
412 op = FETCH2; | |
413 goto docall; | |
414 | |
415 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3: | |
416 case Bcall+4: case Bcall+5: | |
417 op -= Bcall; | |
418 docall: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
419 DISCARD (op); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
420 #ifdef BYTE_CODE_METER |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
421 if (byte_metering_on && SYMBOLP (TOP)) |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
422 { |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
423 v1 = TOP; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
424 v2 = Fget (v1, Qbyte_code_meter); |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
425 if (INTEGERP (v2) |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
426 && XINT (v2) != ((1<<VALBITS)-1)) |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
427 { |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
428 XSETINT (v2, XINT (v2) + 1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
429 Fput (v1, Qbyte_code_meter, v2); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
430 } |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
431 } |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
432 #endif |
310 | 433 TOP = Ffuncall (op + 1, &TOP); |
434 break; | |
435 | |
436 case Bunbind+6: | |
437 op = FETCH; | |
438 goto dounbind; | |
439 | |
440 case Bunbind+7: | |
441 op = FETCH2; | |
442 goto dounbind; | |
443 | |
444 case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3: | |
445 case Bunbind+4: case Bunbind+5: | |
446 op -= Bunbind; | |
447 dounbind: | |
448 unbind_to (specpdl_ptr - specpdl - op, Qnil); | |
449 break; | |
450 | |
451 case Bunbind_all: | |
452 /* To unbind back to the beginning of this frame. Not used yet, | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
453 but will be needed for tail-recursion elimination. */ |
310 | 454 unbind_to (count, Qnil); |
455 break; | |
456 | |
457 case Bgoto: | |
16628 | 458 MAYBE_GC (); |
310 | 459 QUIT; |
460 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ | |
16784
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
461 CHECK_RANGE (op); |
310 | 462 pc = XSTRING (string_saved)->data + op; |
463 break; | |
464 | |
465 case Bgotoifnil: | |
16628 | 466 MAYBE_GC (); |
310 | 467 op = FETCH2; |
944 | 468 if (NILP (POP)) |
310 | 469 { |
470 QUIT; | |
16784
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
471 CHECK_RANGE (op); |
310 | 472 pc = XSTRING (string_saved)->data + op; |
473 } | |
474 break; | |
475 | |
476 case Bgotoifnonnil: | |
16628 | 477 MAYBE_GC (); |
310 | 478 op = FETCH2; |
944 | 479 if (!NILP (POP)) |
310 | 480 { |
481 QUIT; | |
16784
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
482 CHECK_RANGE (op); |
310 | 483 pc = XSTRING (string_saved)->data + op; |
484 } | |
485 break; | |
486 | |
487 case Bgotoifnilelsepop: | |
16628 | 488 MAYBE_GC (); |
310 | 489 op = FETCH2; |
944 | 490 if (NILP (TOP)) |
310 | 491 { |
492 QUIT; | |
16784
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
493 CHECK_RANGE (op); |
310 | 494 pc = XSTRING (string_saved)->data + op; |
495 } | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
496 else DISCARD (1); |
396 | 497 break; |
498 | |
934 | 499 case Bgotoifnonnilelsepop: |
16628 | 500 MAYBE_GC (); |
934 | 501 op = FETCH2; |
944 | 502 if (!NILP (TOP)) |
396 | 503 { |
504 QUIT; | |
16784
79ea730b7e20
(Fbyte_code): Add error check for jumping out of range.
Richard M. Stallman <rms@gnu.org>
parents:
16628
diff
changeset
|
505 CHECK_RANGE (op); |
934 | 506 pc = XSTRING (string_saved)->data + op; |
396 | 507 } |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
508 else DISCARD (1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
509 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
510 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
511 case BRgoto: |
16628 | 512 MAYBE_GC (); |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
513 QUIT; |
15873
77950cb46314
(Fbyte_code): For relative gotos, force signed arithmetic.
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
514 pc += (int) *pc - 127; |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
515 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
516 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
517 case BRgotoifnil: |
16628 | 518 MAYBE_GC (); |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
519 if (NILP (POP)) |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
520 { |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
521 QUIT; |
15873
77950cb46314
(Fbyte_code): For relative gotos, force signed arithmetic.
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
522 pc += (int) *pc - 128; |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
523 } |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
524 pc++; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
525 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
526 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
527 case BRgotoifnonnil: |
16628 | 528 MAYBE_GC (); |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
529 if (!NILP (POP)) |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
530 { |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
531 QUIT; |
15873
77950cb46314
(Fbyte_code): For relative gotos, force signed arithmetic.
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
532 pc += (int) *pc - 128; |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
533 } |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
534 pc++; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
535 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
536 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
537 case BRgotoifnilelsepop: |
16628 | 538 MAYBE_GC (); |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
539 op = *pc++; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
540 if (NILP (TOP)) |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
541 { |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
542 QUIT; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
543 pc += op - 128; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
544 } |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
545 else DISCARD (1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
546 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
547 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
548 case BRgotoifnonnilelsepop: |
16628 | 549 MAYBE_GC (); |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
550 op = *pc++; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
551 if (!NILP (TOP)) |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
552 { |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
553 QUIT; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
554 pc += op - 128; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
555 } |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
556 else DISCARD (1); |
396 | 557 break; |
558 | |
310 | 559 case Breturn: |
560 v1 = POP; | |
561 goto exit; | |
562 | |
563 case Bdiscard: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
564 DISCARD (1); |
310 | 565 break; |
566 | |
567 case Bdup: | |
568 v1 = TOP; | |
569 PUSH (v1); | |
570 break; | |
571 | |
572 case Bconstant2: | |
573 PUSH (vectorp[FETCH2]); | |
574 break; | |
575 | |
576 case Bsave_excursion: | |
577 record_unwind_protect (save_excursion_restore, save_excursion_save ()); | |
578 break; | |
579 | |
16292
86408ea93da6
(Bsave_current_buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16039
diff
changeset
|
580 case Bsave_current_buffer: |
18245 | 581 case Bsave_current_buffer_1: |
20697
6c8ba5a6147b
(Fbyte_code) <Bsave_current_buffer_1>: Use set_buffer_if_live.
Richard M. Stallman <rms@gnu.org>
parents:
20592
diff
changeset
|
582 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); |
16292
86408ea93da6
(Bsave_current_buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16039
diff
changeset
|
583 break; |
86408ea93da6
(Bsave_current_buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16039
diff
changeset
|
584 |
310 | 585 case Bsave_window_excursion: |
586 TOP = Fsave_window_excursion (TOP); | |
587 break; | |
588 | |
589 case Bsave_restriction: | |
590 record_unwind_protect (save_restriction_restore, save_restriction_save ()); | |
591 break; | |
592 | |
593 case Bcatch: | |
594 v1 = POP; | |
595 TOP = internal_catch (TOP, Feval, v1); | |
596 break; | |
597 | |
598 case Bunwind_protect: | |
599 record_unwind_protect (0, POP); | |
600 (specpdl_ptr - 1)->symbol = Qnil; | |
601 break; | |
602 | |
603 case Bcondition_case: | |
604 v1 = POP; | |
605 v1 = Fcons (POP, v1); | |
606 TOP = Fcondition_case (Fcons (TOP, v1)); | |
607 break; | |
608 | |
609 case Btemp_output_buffer_setup: | |
610 temp_output_buffer_setup (XSTRING (TOP)->data); | |
611 TOP = Vstandard_output; | |
612 break; | |
613 | |
614 case Btemp_output_buffer_show: | |
615 v1 = POP; | |
1911
d9fc49956cd8
* bytecode.c (Fbyte_code): Pass the correct number of arguments to
Jim Blandy <jimb@redhat.com>
parents:
1503
diff
changeset
|
616 temp_output_buffer_show (TOP); |
310 | 617 TOP = v1; |
618 /* pop binding of standard-output */ | |
619 unbind_to (specpdl_ptr - specpdl - 1, Qnil); | |
620 break; | |
621 | |
622 case Bnth: | |
623 v1 = POP; | |
624 v2 = TOP; | |
625 nth_entry: | |
626 CHECK_NUMBER (v2, 0); | |
627 op = XINT (v2); | |
628 immediate_quit = 1; | |
629 while (--op >= 0) | |
630 { | |
631 if (CONSP (v1)) | |
632 v1 = XCONS (v1)->cdr; | |
944 | 633 else if (!NILP (v1)) |
310 | 634 { |
635 immediate_quit = 0; | |
636 v1 = wrong_type_argument (Qlistp, v1); | |
637 immediate_quit = 1; | |
638 op++; | |
639 } | |
640 } | |
641 immediate_quit = 0; | |
642 goto docar; | |
643 | |
644 case Bsymbolp: | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
645 TOP = SYMBOLP (TOP) ? Qt : Qnil; |
310 | 646 break; |
647 | |
648 case Bconsp: | |
649 TOP = CONSP (TOP) ? Qt : Qnil; | |
650 break; | |
651 | |
652 case Bstringp: | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
653 TOP = STRINGP (TOP) ? Qt : Qnil; |
310 | 654 break; |
655 | |
656 case Blistp: | |
944 | 657 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; |
310 | 658 break; |
659 | |
660 case Beq: | |
661 v1 = POP; | |
662 TOP = EQ (v1, TOP) ? Qt : Qnil; | |
663 break; | |
664 | |
665 case Bmemq: | |
666 v1 = POP; | |
667 TOP = Fmemq (TOP, v1); | |
668 break; | |
669 | |
670 case Bnot: | |
944 | 671 TOP = NILP (TOP) ? Qt : Qnil; |
310 | 672 break; |
673 | |
674 case Bcar: | |
675 v1 = TOP; | |
676 docar: | |
677 if (CONSP (v1)) TOP = XCONS (v1)->car; | |
944 | 678 else if (NILP (v1)) TOP = Qnil; |
310 | 679 else Fcar (wrong_type_argument (Qlistp, v1)); |
680 break; | |
681 | |
682 case Bcdr: | |
683 v1 = TOP; | |
684 if (CONSP (v1)) TOP = XCONS (v1)->cdr; | |
944 | 685 else if (NILP (v1)) TOP = Qnil; |
310 | 686 else Fcdr (wrong_type_argument (Qlistp, v1)); |
687 break; | |
688 | |
689 case Bcons: | |
690 v1 = POP; | |
691 TOP = Fcons (TOP, v1); | |
692 break; | |
693 | |
694 case Blist1: | |
695 TOP = Fcons (TOP, Qnil); | |
696 break; | |
697 | |
698 case Blist2: | |
699 v1 = POP; | |
700 TOP = Fcons (TOP, Fcons (v1, Qnil)); | |
701 break; | |
702 | |
703 case Blist3: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
704 DISCARD (2); |
310 | 705 TOP = Flist (3, &TOP); |
706 break; | |
707 | |
708 case Blist4: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
709 DISCARD (3); |
310 | 710 TOP = Flist (4, &TOP); |
711 break; | |
712 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
713 case BlistN: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
714 op = FETCH; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
715 DISCARD (op - 1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
716 TOP = Flist (op, &TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
717 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
718 |
310 | 719 case Blength: |
720 TOP = Flength (TOP); | |
721 break; | |
722 | |
723 case Baref: | |
724 v1 = POP; | |
725 TOP = Faref (TOP, v1); | |
726 break; | |
727 | |
728 case Baset: | |
729 v2 = POP; v1 = POP; | |
730 TOP = Faset (TOP, v1, v2); | |
731 break; | |
732 | |
733 case Bsymbol_value: | |
734 TOP = Fsymbol_value (TOP); | |
735 break; | |
736 | |
737 case Bsymbol_function: | |
738 TOP = Fsymbol_function (TOP); | |
739 break; | |
740 | |
741 case Bset: | |
742 v1 = POP; | |
743 TOP = Fset (TOP, v1); | |
744 break; | |
745 | |
746 case Bfset: | |
747 v1 = POP; | |
748 TOP = Ffset (TOP, v1); | |
749 break; | |
750 | |
751 case Bget: | |
752 v1 = POP; | |
753 TOP = Fget (TOP, v1); | |
754 break; | |
755 | |
756 case Bsubstring: | |
757 v2 = POP; v1 = POP; | |
758 TOP = Fsubstring (TOP, v1, v2); | |
759 break; | |
760 | |
761 case Bconcat2: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
762 DISCARD (1); |
310 | 763 TOP = Fconcat (2, &TOP); |
764 break; | |
765 | |
766 case Bconcat3: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
767 DISCARD (2); |
310 | 768 TOP = Fconcat (3, &TOP); |
769 break; | |
770 | |
771 case Bconcat4: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
772 DISCARD (3); |
310 | 773 TOP = Fconcat (4, &TOP); |
774 break; | |
775 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
776 case BconcatN: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
777 op = FETCH; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
778 DISCARD (op - 1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
779 TOP = Fconcat (op, &TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
780 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
781 |
310 | 782 case Bsub1: |
783 v1 = TOP; | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
784 if (INTEGERP (v1)) |
310 | 785 { |
786 XSETINT (v1, XINT (v1) - 1); | |
787 TOP = v1; | |
788 } | |
789 else | |
790 TOP = Fsub1 (v1); | |
791 break; | |
792 | |
793 case Badd1: | |
794 v1 = TOP; | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
795 if (INTEGERP (v1)) |
310 | 796 { |
797 XSETINT (v1, XINT (v1) + 1); | |
798 TOP = v1; | |
799 } | |
800 else | |
801 TOP = Fadd1 (v1); | |
802 break; | |
803 | |
804 case Beqlsign: | |
805 v2 = POP; v1 = TOP; | |
806 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0); | |
807 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0); | |
12527
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
808 #ifdef LISP_FLOAT_TYPE |
12574
bbd93011edef
(Fbyte_code): Fix variable names in previous change.
Karl Heuer <kwzh@gnu.org>
parents:
12527
diff
changeset
|
809 if (FLOATP (v1) || FLOATP (v2)) |
12527
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
810 { |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
811 double f1, f2; |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
812 |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
813 f1 = (FLOATP (v1) ? XFLOAT (v1)->data : XINT (v1)); |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
814 f2 = (FLOATP (v2) ? XFLOAT (v2)->data : XINT (v2)); |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
815 TOP = (f1 == f2 ? Qt : Qnil); |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
816 } |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
817 else |
ebaf016075f1
(Fbyte_code): For Beqlsign, if both args are ints,
Karl Heuer <kwzh@gnu.org>
parents:
10134
diff
changeset
|
818 #endif |
12575 | 819 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); |
310 | 820 break; |
821 | |
822 case Bgtr: | |
823 v1 = POP; | |
824 TOP = Fgtr (TOP, v1); | |
825 break; | |
826 | |
827 case Blss: | |
828 v1 = POP; | |
829 TOP = Flss (TOP, v1); | |
830 break; | |
831 | |
832 case Bleq: | |
833 v1 = POP; | |
834 TOP = Fleq (TOP, v1); | |
835 break; | |
836 | |
837 case Bgeq: | |
838 v1 = POP; | |
839 TOP = Fgeq (TOP, v1); | |
840 break; | |
841 | |
842 case Bdiff: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
843 DISCARD (1); |
310 | 844 TOP = Fminus (2, &TOP); |
845 break; | |
846 | |
847 case Bnegate: | |
848 v1 = TOP; | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
849 if (INTEGERP (v1)) |
310 | 850 { |
851 XSETINT (v1, - XINT (v1)); | |
852 TOP = v1; | |
853 } | |
854 else | |
855 TOP = Fminus (1, &TOP); | |
856 break; | |
857 | |
858 case Bplus: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
859 DISCARD (1); |
310 | 860 TOP = Fplus (2, &TOP); |
861 break; | |
862 | |
863 case Bmax: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
864 DISCARD (1); |
310 | 865 TOP = Fmax (2, &TOP); |
866 break; | |
867 | |
868 case Bmin: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
869 DISCARD (1); |
310 | 870 TOP = Fmin (2, &TOP); |
871 break; | |
872 | |
873 case Bmult: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
874 DISCARD (1); |
310 | 875 TOP = Ftimes (2, &TOP); |
876 break; | |
877 | |
878 case Bquo: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
879 DISCARD (1); |
310 | 880 TOP = Fquo (2, &TOP); |
881 break; | |
882 | |
883 case Brem: | |
884 v1 = POP; | |
885 TOP = Frem (TOP, v1); | |
886 break; | |
887 | |
888 case Bpoint: | |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15873
diff
changeset
|
889 XSETFASTINT (v1, PT); |
310 | 890 PUSH (v1); |
891 break; | |
892 | |
893 case Bgoto_char: | |
894 TOP = Fgoto_char (TOP); | |
895 break; | |
896 | |
897 case Binsert: | |
898 TOP = Finsert (1, &TOP); | |
899 break; | |
900 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
901 case BinsertN: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
902 op = FETCH; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
903 DISCARD (op - 1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
904 TOP = Finsert (op, &TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
905 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
906 |
310 | 907 case Bpoint_max: |
9297
5151ce5ab25a
(Fbyte_code): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9139
diff
changeset
|
908 XSETFASTINT (v1, ZV); |
310 | 909 PUSH (v1); |
910 break; | |
911 | |
912 case Bpoint_min: | |
9297
5151ce5ab25a
(Fbyte_code): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9139
diff
changeset
|
913 XSETFASTINT (v1, BEGV); |
310 | 914 PUSH (v1); |
915 break; | |
916 | |
917 case Bchar_after: | |
918 TOP = Fchar_after (TOP); | |
919 break; | |
920 | |
921 case Bfollowing_char: | |
10134
c681703f7ce3
(Fbyte_code): Call Ffollowing_char and Fprevious_char
Richard M. Stallman <rms@gnu.org>
parents:
9894
diff
changeset
|
922 v1 = Ffollowing_char (); |
310 | 923 PUSH (v1); |
924 break; | |
925 | |
926 case Bpreceding_char: | |
10134
c681703f7ce3
(Fbyte_code): Call Ffollowing_char and Fprevious_char
Richard M. Stallman <rms@gnu.org>
parents:
9894
diff
changeset
|
927 v1 = Fprevious_char (); |
310 | 928 PUSH (v1); |
929 break; | |
930 | |
931 case Bcurrent_column: | |
9297
5151ce5ab25a
(Fbyte_code): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9139
diff
changeset
|
932 XSETFASTINT (v1, current_column ()); |
310 | 933 PUSH (v1); |
934 break; | |
935 | |
936 case Bindent_to: | |
937 TOP = Findent_to (TOP, Qnil); | |
938 break; | |
939 | |
940 case Beolp: | |
941 PUSH (Feolp ()); | |
942 break; | |
943 | |
944 case Beobp: | |
945 PUSH (Feobp ()); | |
946 break; | |
947 | |
948 case Bbolp: | |
949 PUSH (Fbolp ()); | |
950 break; | |
951 | |
952 case Bbobp: | |
953 PUSH (Fbobp ()); | |
954 break; | |
955 | |
956 case Bcurrent_buffer: | |
957 PUSH (Fcurrent_buffer ()); | |
958 break; | |
959 | |
960 case Bset_buffer: | |
961 TOP = Fset_buffer (TOP); | |
962 break; | |
963 | |
964 case Binteractive_p: | |
965 PUSH (Finteractive_p ()); | |
966 break; | |
967 | |
968 case Bforward_char: | |
969 TOP = Fforward_char (TOP); | |
970 break; | |
971 | |
972 case Bforward_word: | |
973 TOP = Fforward_word (TOP); | |
974 break; | |
975 | |
976 case Bskip_chars_forward: | |
977 v1 = POP; | |
978 TOP = Fskip_chars_forward (TOP, v1); | |
979 break; | |
980 | |
981 case Bskip_chars_backward: | |
982 v1 = POP; | |
983 TOP = Fskip_chars_backward (TOP, v1); | |
984 break; | |
985 | |
986 case Bforward_line: | |
987 TOP = Fforward_line (TOP); | |
988 break; | |
989 | |
990 case Bchar_syntax: | |
991 CHECK_NUMBER (TOP, 0); | |
9297
5151ce5ab25a
(Fbyte_code): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9139
diff
changeset
|
992 XSETFASTINT (TOP, |
10134
c681703f7ce3
(Fbyte_code): Call Ffollowing_char and Fprevious_char
Richard M. Stallman <rms@gnu.org>
parents:
9894
diff
changeset
|
993 syntax_code_spec[(int) SYNTAX (XINT (TOP))]); |
310 | 994 break; |
995 | |
996 case Bbuffer_substring: | |
997 v1 = POP; | |
998 TOP = Fbuffer_substring (TOP, v1); | |
999 break; | |
1000 | |
1001 case Bdelete_region: | |
1002 v1 = POP; | |
1003 TOP = Fdelete_region (TOP, v1); | |
1004 break; | |
1005 | |
1006 case Bnarrow_to_region: | |
1007 v1 = POP; | |
1008 TOP = Fnarrow_to_region (TOP, v1); | |
1009 break; | |
1010 | |
1011 case Bwiden: | |
1012 PUSH (Fwiden ()); | |
1013 break; | |
1014 | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1015 case Bend_of_line: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1016 TOP = Fend_of_line (TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1017 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1018 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1019 case Bset_marker: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1020 v1 = POP; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1021 v2 = POP; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1022 TOP = Fset_marker (TOP, v2, v1); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1023 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1024 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1025 case Bmatch_beginning: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1026 TOP = Fmatch_beginning (TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1027 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1028 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1029 case Bmatch_end: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1030 TOP = Fmatch_end (TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1031 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1032 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1033 case Bupcase: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1034 TOP = Fupcase (TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1035 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1036 |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1037 case Bdowncase: |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1038 TOP = Fdowncase (TOP); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1039 break; |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1040 |
310 | 1041 case Bstringeqlsign: |
1042 v1 = POP; | |
1043 TOP = Fstring_equal (TOP, v1); | |
1044 break; | |
1045 | |
1046 case Bstringlss: | |
1047 v1 = POP; | |
1048 TOP = Fstring_lessp (TOP, v1); | |
1049 break; | |
1050 | |
1051 case Bequal: | |
1052 v1 = POP; | |
1053 TOP = Fequal (TOP, v1); | |
1054 break; | |
1055 | |
1056 case Bnthcdr: | |
1057 v1 = POP; | |
1058 TOP = Fnthcdr (TOP, v1); | |
1059 break; | |
1060 | |
1061 case Belt: | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
1062 if (CONSP (TOP)) |
310 | 1063 { |
1064 /* Exchange args and then do nth. */ | |
1065 v2 = POP; | |
1066 v1 = TOP; | |
1067 goto nth_entry; | |
1068 } | |
1069 v1 = POP; | |
1070 TOP = Felt (TOP, v1); | |
1071 break; | |
1072 | |
1073 case Bmember: | |
1074 v1 = POP; | |
1075 TOP = Fmember (TOP, v1); | |
1076 break; | |
1077 | |
1078 case Bassq: | |
1079 v1 = POP; | |
1080 TOP = Fassq (TOP, v1); | |
1081 break; | |
1082 | |
1083 case Bnreverse: | |
1084 TOP = Fnreverse (TOP); | |
1085 break; | |
1086 | |
1087 case Bsetcar: | |
1088 v1 = POP; | |
1089 TOP = Fsetcar (TOP, v1); | |
1090 break; | |
1091 | |
1092 case Bsetcdr: | |
1093 v1 = POP; | |
1094 TOP = Fsetcdr (TOP, v1); | |
1095 break; | |
1096 | |
1097 case Bcar_safe: | |
1098 v1 = TOP; | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
1099 if (CONSP (v1)) |
310 | 1100 TOP = XCONS (v1)->car; |
1101 else | |
1102 TOP = Qnil; | |
1103 break; | |
1104 | |
1105 case Bcdr_safe: | |
1106 v1 = TOP; | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
1107 if (CONSP (v1)) |
310 | 1108 TOP = XCONS (v1)->cdr; |
1109 else | |
1110 TOP = Qnil; | |
1111 break; | |
1112 | |
1113 case Bnconc: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1114 DISCARD (1); |
310 | 1115 TOP = Fnconc (2, &TOP); |
1116 break; | |
1117 | |
1118 case Bnumberp: | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1119 TOP = (NUMBERP (TOP) ? Qt : Qnil); |
310 | 1120 break; |
1121 | |
1122 case Bintegerp: | |
9139
127823d9444d
(Fbyte_code): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
1123 TOP = INTEGERP (TOP) ? Qt : Qnil; |
310 | 1124 break; |
1125 | |
1126 #ifdef BYTE_CODE_SAFE | |
1127 case Bset_mark: | |
1128 error ("set-mark is an obsolete bytecode"); | |
1129 break; | |
1130 case Bscan_buffer: | |
1131 error ("scan-buffer is an obsolete bytecode"); | |
1132 break; | |
1133 #endif | |
1134 | |
1135 default: | |
1136 #ifdef BYTE_CODE_SAFE | |
1137 if (op < Bconstant) | |
1138 error ("unknown bytecode %d (byte compiler bug)", op); | |
1139 if ((op -= Bconstant) >= const_length) | |
1140 error ("no constant number %d (byte compiler bug)", op); | |
1141 PUSH (vectorp[op]); | |
1142 #else | |
1143 PUSH (vectorp[op - Bconstant]); | |
1144 #endif | |
1145 } | |
1146 } | |
1147 | |
1148 exit: | |
1149 UNGCPRO; | |
1150 /* Binds and unbinds are supposed to be compiled balanced. */ | |
1151 if (specpdl_ptr - specpdl != count) | |
1152 #ifdef BYTE_CODE_SAFE | |
1153 error ("binding stack not balanced (serious byte compiler bug)"); | |
1154 #else | |
1155 abort (); | |
1156 #endif | |
1157 return v1; | |
1158 } | |
1159 | |
21514 | 1160 void |
310 | 1161 syms_of_bytecode () |
1162 { | |
1163 Qbytecode = intern ("byte-code"); | |
1164 staticpro (&Qbytecode); | |
1165 | |
1166 defsubr (&Sbyte_code); | |
1167 | |
1168 #ifdef BYTE_CODE_METER | |
1169 | |
1170 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1171 "A vector of vectors which holds a histogram of byte-code usage.\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1172 (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1173 opcode CODE has been executed.\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1174 (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1175 indicates how many times the byte opcodes CODE1 and CODE2 have been\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1176 executed in succession."); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1177 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1178 "If non-nil, keep profiling information on byte code usage.\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1179 The variable byte-code-meter indicates how often each byte opcode is used.\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1180 If a symbol has a property named `byte-code-meter' whose value is an\n\ |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1181 integer, it is incremented each time that symbol's function is called."); |
310 | 1182 |
1183 byte_metering_on = 0; | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1184 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1185 Qbyte_code_meter = intern ("byte-code-meter"); |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1186 staticpro (&Qbyte_code_meter); |
310 | 1187 { |
1188 int i = 256; | |
1189 while (i--) | |
959
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1190 XVECTOR (Vbyte_code_meter)->contents[i] = |
c1fc76b79275
* bytecode.c (Fbyte_code): When metering the Bcall opcodes, make
Jim Blandy <jimb@redhat.com>
parents:
944
diff
changeset
|
1191 Fmake_vector (make_number (256), make_number (0)); |
310 | 1192 } |
1193 #endif | |
1194 } |