Commit | Line | Data |
---|---|---|
a5bbb22e | 1 | /* Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc. |
a98cef7e | 2 | * |
53e28ed9 | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
4 | * modify it under the terms of the GNU Lesser General Public License |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
a98cef7e | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
53e28ed9 AW |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
a98cef7e | 12 | * |
53e28ed9 AW |
13 | * You should have received a copy of the GNU Lesser General Public |
14 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
53e28ed9 AW |
17 | */ |
18 | ||
a98cef7e KN |
19 | |
20 | /* This file is included in vm_engine.c */ | |
21 | ||
a98cef7e KN |
22 | \f |
23 | /* | |
24 | * Basic operations | |
25 | */ | |
26 | ||
53e28ed9 | 27 | VM_DEFINE_INSTRUCTION (0, nop, "nop", 0, 0, 0) |
a98cef7e KN |
28 | { |
29 | NEXT; | |
30 | } | |
31 | ||
53e28ed9 | 32 | VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0) |
a98cef7e | 33 | { |
17e90c5e | 34 | HALT_HOOK (); |
a222b0fa | 35 | nvalues = SCM_I_INUM (*sp--); |
11ea1aba | 36 | NULLSTACK (1); |
a222b0fa | 37 | if (nvalues == 1) |
e06e857c | 38 | POP (finish_args); |
a222b0fa AW |
39 | else |
40 | { | |
41 | POP_LIST (nvalues); | |
e06e857c | 42 | POP (finish_args); |
877ffa3f | 43 | SYNC_REGISTER (); |
e06e857c | 44 | finish_args = scm_values (finish_args); |
a222b0fa AW |
45 | } |
46 | ||
1dc8f851 | 47 | { |
6c6a4439 AW |
48 | #ifdef VM_ENABLE_STACK_NULLING |
49 | SCM *old_sp = sp; | |
50 | #endif | |
1dc8f851 AW |
51 | |
52 | /* Restore registers */ | |
53 | sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; | |
6c6a4439 AW |
54 | /* Setting the ip here doesn't actually affect control flow, as the calling |
55 | code will restore its own registers, but it does help when walking the | |
56 | stack */ | |
57 | ip = SCM_FRAME_RETURN_ADDRESS (fp); | |
1dc8f851 | 58 | fp = SCM_FRAME_DYNAMIC_LINK (fp); |
6c6a4439 | 59 | NULLSTACK (old_sp - sp); |
1dc8f851 | 60 | } |
e06e857c AW |
61 | |
62 | goto vm_done; | |
a98cef7e KN |
63 | } |
64 | ||
53e28ed9 | 65 | VM_DEFINE_INSTRUCTION (2, break, "break", 0, 0, 0) |
7a0d0cee KN |
66 | { |
67 | BREAK_HOOK (); | |
68 | NEXT; | |
69 | } | |
70 | ||
131f7d6c | 71 | VM_DEFINE_INSTRUCTION (3, drop, "drop", 0, 1, 0) |
a98cef7e | 72 | { |
17e90c5e | 73 | DROP (); |
a98cef7e KN |
74 | NEXT; |
75 | } | |
76 | ||
d94be25f | 77 | VM_DEFINE_INSTRUCTION (4, dup, "dup", 0, 0, 1) |
26403690 | 78 | { |
f349065e KN |
79 | SCM x = *sp; |
80 | PUSH (x); | |
26403690 KN |
81 | NEXT; |
82 | } | |
83 | ||
17e90c5e KN |
84 | \f |
85 | /* | |
86 | * Object creation | |
87 | */ | |
a98cef7e | 88 | |
d94be25f | 89 | VM_DEFINE_INSTRUCTION (5, void, "void", 0, 0, 1) |
a98cef7e | 90 | { |
17e90c5e | 91 | PUSH (SCM_UNSPECIFIED); |
a98cef7e KN |
92 | NEXT; |
93 | } | |
94 | ||
d94be25f | 95 | VM_DEFINE_INSTRUCTION (6, make_true, "make-true", 0, 0, 1) |
a98cef7e | 96 | { |
17e90c5e | 97 | PUSH (SCM_BOOL_T); |
a98cef7e KN |
98 | NEXT; |
99 | } | |
100 | ||
d94be25f | 101 | VM_DEFINE_INSTRUCTION (7, make_false, "make-false", 0, 0, 1) |
a98cef7e | 102 | { |
17e90c5e | 103 | PUSH (SCM_BOOL_F); |
a98cef7e KN |
104 | NEXT; |
105 | } | |
106 | ||
ff810079 | 107 | VM_DEFINE_INSTRUCTION (8, make_nil, "make-nil", 0, 0, 1) |
4530432e DK |
108 | { |
109 | PUSH (SCM_ELISP_NIL); | |
110 | NEXT; | |
111 | } | |
112 | ||
53e28ed9 | 113 | VM_DEFINE_INSTRUCTION (9, make_eol, "make-eol", 0, 0, 1) |
a98cef7e | 114 | { |
17e90c5e | 115 | PUSH (SCM_EOL); |
a98cef7e KN |
116 | NEXT; |
117 | } | |
118 | ||
53e28ed9 | 119 | VM_DEFINE_INSTRUCTION (10, make_int8, "make-int8", 1, 0, 1) |
a98cef7e | 120 | { |
2d80426a | 121 | PUSH (SCM_I_MAKINUM ((signed char) FETCH ())); |
a98cef7e KN |
122 | NEXT; |
123 | } | |
124 | ||
53e28ed9 | 125 | VM_DEFINE_INSTRUCTION (11, make_int8_0, "make-int8:0", 0, 0, 1) |
a98cef7e | 126 | { |
238e7a11 | 127 | PUSH (SCM_INUM0); |
a98cef7e KN |
128 | NEXT; |
129 | } | |
130 | ||
53e28ed9 | 131 | VM_DEFINE_INSTRUCTION (12, make_int8_1, "make-int8:1", 0, 0, 1) |
a98cef7e | 132 | { |
238e7a11 | 133 | PUSH (SCM_I_MAKINUM (1)); |
a98cef7e KN |
134 | NEXT; |
135 | } | |
136 | ||
53e28ed9 | 137 | VM_DEFINE_INSTRUCTION (13, make_int16, "make-int16", 2, 0, 1) |
a98cef7e | 138 | { |
ea9b4b29 KN |
139 | int h = FETCH (); |
140 | int l = FETCH (); | |
2d80426a | 141 | PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l)); |
a98cef7e KN |
142 | NEXT; |
143 | } | |
144 | ||
a5cfddd5 | 145 | VM_DEFINE_INSTRUCTION (14, make_int64, "make-int64", 8, 0, 1) |
586cfdec AW |
146 | { |
147 | scm_t_uint64 v = 0; | |
148 | v += FETCH (); | |
149 | v <<= 8; v += FETCH (); | |
150 | v <<= 8; v += FETCH (); | |
151 | v <<= 8; v += FETCH (); | |
152 | v <<= 8; v += FETCH (); | |
153 | v <<= 8; v += FETCH (); | |
154 | v <<= 8; v += FETCH (); | |
155 | v <<= 8; v += FETCH (); | |
156 | PUSH (scm_from_int64 ((scm_t_int64) v)); | |
157 | NEXT; | |
158 | } | |
159 | ||
a5cfddd5 | 160 | VM_DEFINE_INSTRUCTION (15, make_uint64, "make-uint64", 8, 0, 1) |
586cfdec AW |
161 | { |
162 | scm_t_uint64 v = 0; | |
163 | v += FETCH (); | |
164 | v <<= 8; v += FETCH (); | |
165 | v <<= 8; v += FETCH (); | |
166 | v <<= 8; v += FETCH (); | |
167 | v <<= 8; v += FETCH (); | |
168 | v <<= 8; v += FETCH (); | |
169 | v <<= 8; v += FETCH (); | |
170 | v <<= 8; v += FETCH (); | |
171 | PUSH (scm_from_uint64 (v)); | |
172 | NEXT; | |
173 | } | |
174 | ||
a5cfddd5 | 175 | VM_DEFINE_INSTRUCTION (16, make_char8, "make-char8", 1, 0, 1) |
a98cef7e | 176 | { |
4c402b88 MG |
177 | scm_t_uint8 v = 0; |
178 | v = FETCH (); | |
179 | ||
180 | PUSH (SCM_MAKE_CHAR (v)); | |
181 | /* Don't simplify this to PUSH (SCM_MAKE_CHAR (FETCH ())). The | |
182 | contents of SCM_MAKE_CHAR may be evaluated more than once, | |
183 | resulting in a double fetch. */ | |
a98cef7e KN |
184 | NEXT; |
185 | } | |
186 | ||
ff810079 | 187 | VM_DEFINE_INSTRUCTION (17, make_char32, "make-char32", 4, 0, 1) |
904a78f1 MG |
188 | { |
189 | scm_t_wchar v = 0; | |
190 | v += FETCH (); | |
191 | v <<= 8; v += FETCH (); | |
192 | v <<= 8; v += FETCH (); | |
193 | v <<= 8; v += FETCH (); | |
194 | PUSH (SCM_MAKE_CHAR (v)); | |
195 | NEXT; | |
196 | } | |
197 | ||
198 | ||
199 | ||
ff810079 | 200 | VM_DEFINE_INSTRUCTION (18, list, "list", 2, -1, 1) |
cb4cca12 | 201 | { |
23b587b0 LC |
202 | unsigned h = FETCH (); |
203 | unsigned l = FETCH (); | |
204 | unsigned len = ((h << 8) + l); | |
205 | POP_LIST (len); | |
cb4cca12 KN |
206 | NEXT; |
207 | } | |
208 | ||
ff810079 | 209 | VM_DEFINE_INSTRUCTION (19, vector, "vector", 2, -1, 1) |
cb4cca12 | 210 | { |
23b587b0 LC |
211 | unsigned h = FETCH (); |
212 | unsigned l = FETCH (); | |
213 | unsigned len = ((h << 8) + l); | |
5338b62b AW |
214 | SCM vect; |
215 | ||
877ffa3f | 216 | SYNC_REGISTER (); |
5338b62b AW |
217 | sp++; sp -= len; |
218 | CHECK_UNDERFLOW (); | |
219 | vect = scm_make_vector (scm_from_uint (len), SCM_BOOL_F); | |
220 | memcpy (SCM_I_VECTOR_WELTS(vect), sp, sizeof(SCM) * len); | |
221 | NULLSTACK (len); | |
222 | *sp = vect; | |
223 | ||
cb4cca12 KN |
224 | NEXT; |
225 | } | |
226 | ||
a98cef7e KN |
227 | \f |
228 | /* | |
17e90c5e | 229 | * Variable access |
a98cef7e KN |
230 | */ |
231 | ||
17e90c5e KN |
232 | #define OBJECT_REF(i) objects[i] |
233 | #define OBJECT_SET(i,o) objects[i] = o | |
a98cef7e | 234 | |
af988bbf KN |
235 | #define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i) |
236 | #define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o | |
a98cef7e | 237 | |
2d80426a LC |
238 | /* For the variable operations, we _must_ obviously avoid function calls to |
239 | `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do | |
240 | nothing more than the corresponding macros. */ | |
241 | #define VARIABLE_REF(v) SCM_VARIABLE_REF (v) | |
242 | #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) | |
243 | #define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED) | |
a98cef7e | 244 | |
6f16379e | 245 | #define FREE_VARIABLE_REF(i) SCM_PROGRAM_FREE_VARIABLE_REF (program, i) |
8d90b356 | 246 | |
17e90c5e | 247 | /* ref */ |
a98cef7e | 248 | |
ff810079 | 249 | VM_DEFINE_INSTRUCTION (20, object_ref, "object-ref", 1, 0, 1) |
a98cef7e | 250 | { |
a52b2d3d | 251 | register unsigned objnum = FETCH (); |
0b5f0e49 LC |
252 | CHECK_OBJECT (objnum); |
253 | PUSH (OBJECT_REF (objnum)); | |
17e90c5e | 254 | NEXT; |
a98cef7e KN |
255 | } |
256 | ||
a5cfddd5 | 257 | /* FIXME: necessary? elt 255 of the vector could be a vector... */ |
ff810079 | 258 | VM_DEFINE_INSTRUCTION (21, long_object_ref, "long-object-ref", 2, 0, 1) |
a5cfddd5 AW |
259 | { |
260 | unsigned int objnum = FETCH (); | |
261 | objnum <<= 8; | |
262 | objnum += FETCH (); | |
263 | CHECK_OBJECT (objnum); | |
264 | PUSH (OBJECT_REF (objnum)); | |
265 | NEXT; | |
266 | } | |
267 | ||
ff810079 | 268 | VM_DEFINE_INSTRUCTION (22, local_ref, "local-ref", 1, 0, 1) |
a98cef7e | 269 | { |
17e90c5e | 270 | PUSH (LOCAL_REF (FETCH ())); |
a1a482e0 | 271 | ASSERT_BOUND (*sp); |
17e90c5e | 272 | NEXT; |
a98cef7e KN |
273 | } |
274 | ||
ff810079 | 275 | VM_DEFINE_INSTRUCTION (23, long_local_ref, "long-local-ref", 2, 0, 1) |
a98cef7e | 276 | { |
80545853 AW |
277 | unsigned int i = FETCH (); |
278 | i <<= 8; | |
279 | i += FETCH (); | |
28b119ee | 280 | PUSH (LOCAL_REF (i)); |
a1a482e0 | 281 | ASSERT_BOUND (*sp); |
a98cef7e KN |
282 | NEXT; |
283 | } | |
284 | ||
e4257331 | 285 | VM_DEFINE_INSTRUCTION (24, local_bound, "local-bound?", 1, 0, 1) |
3092a14d AW |
286 | { |
287 | if (LOCAL_REF (FETCH ()) == SCM_UNDEFINED) | |
288 | PUSH (SCM_BOOL_F); | |
289 | else | |
290 | PUSH (SCM_BOOL_T); | |
291 | NEXT; | |
292 | } | |
293 | ||
e4257331 | 294 | VM_DEFINE_INSTRUCTION (25, long_local_bound, "long-local-bound?", 2, 0, 1) |
3092a14d AW |
295 | { |
296 | unsigned int i = FETCH (); | |
297 | i <<= 8; | |
298 | i += FETCH (); | |
299 | if (LOCAL_REF (i) == SCM_UNDEFINED) | |
300 | PUSH (SCM_BOOL_F); | |
301 | else | |
302 | PUSH (SCM_BOOL_T); | |
303 | NEXT; | |
304 | } | |
305 | ||
e4257331 | 306 | VM_DEFINE_INSTRUCTION (26, variable_ref, "variable-ref", 0, 1, 1) |
a98cef7e | 307 | { |
17e90c5e | 308 | SCM x = *sp; |
238e7a11 | 309 | |
2d80426a | 310 | if (!VARIABLE_BOUNDP (x)) |
17e90c5e | 311 | { |
da8b4747 | 312 | finish_args = scm_list_1 (x); |
e06e857c | 313 | /* Was: finish_args = SCM_LIST1 (SCM_CAR (x)); */ |
17e90c5e KN |
314 | goto vm_error_unbound; |
315 | } | |
238e7a11 LC |
316 | else |
317 | { | |
2d80426a | 318 | SCM o = VARIABLE_REF (x); |
238e7a11 LC |
319 | *sp = o; |
320 | } | |
321 | ||
a98cef7e KN |
322 | NEXT; |
323 | } | |
324 | ||
05156612 | 325 | VM_DEFINE_INSTRUCTION (27, variable_bound, "variable-bound?", 0, 1, 1) |
3092a14d AW |
326 | { |
327 | if (VARIABLE_BOUNDP (*sp)) | |
328 | *sp = SCM_BOOL_T; | |
329 | else | |
330 | *sp = SCM_BOOL_F; | |
331 | NEXT; | |
332 | } | |
333 | ||
e4257331 | 334 | VM_DEFINE_INSTRUCTION (28, toplevel_ref, "toplevel-ref", 1, 0, 1) |
9cc649b8 | 335 | { |
6297d229 | 336 | unsigned objnum = FETCH (); |
fd358575 | 337 | SCM what; |
9cc649b8 | 338 | CHECK_OBJECT (objnum); |
fd358575 | 339 | what = OBJECT_REF (objnum); |
9cc649b8 | 340 | |
fd358575 | 341 | if (!SCM_VARIABLEP (what)) |
9cc649b8 | 342 | { |
d0168f3d | 343 | SYNC_REGISTER (); |
b7393ea1 | 344 | what = resolve_variable (what, scm_program_module (program)); |
fd358575 | 345 | if (!VARIABLE_BOUNDP (what)) |
9cc649b8 | 346 | { |
da8b4747 | 347 | finish_args = scm_list_1 (what); |
9cc649b8 AW |
348 | goto vm_error_unbound; |
349 | } | |
fd358575 | 350 | OBJECT_SET (objnum, what); |
9cc649b8 AW |
351 | } |
352 | ||
fd358575 | 353 | PUSH (VARIABLE_REF (what)); |
9cc649b8 AW |
354 | NEXT; |
355 | } | |
356 | ||
e4257331 | 357 | VM_DEFINE_INSTRUCTION (29, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1) |
a5cfddd5 AW |
358 | { |
359 | SCM what; | |
360 | unsigned int objnum = FETCH (); | |
361 | objnum <<= 8; | |
362 | objnum += FETCH (); | |
363 | CHECK_OBJECT (objnum); | |
364 | what = OBJECT_REF (objnum); | |
365 | ||
366 | if (!SCM_VARIABLEP (what)) | |
367 | { | |
368 | SYNC_REGISTER (); | |
369 | what = resolve_variable (what, scm_program_module (program)); | |
370 | if (!VARIABLE_BOUNDP (what)) | |
371 | { | |
372 | finish_args = scm_list_1 (what); | |
373 | goto vm_error_unbound; | |
374 | } | |
375 | OBJECT_SET (objnum, what); | |
376 | } | |
377 | ||
378 | PUSH (VARIABLE_REF (what)); | |
379 | NEXT; | |
380 | } | |
381 | ||
17e90c5e KN |
382 | /* set */ |
383 | ||
e4257331 | 384 | VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0) |
a98cef7e | 385 | { |
17e90c5e KN |
386 | LOCAL_SET (FETCH (), *sp); |
387 | DROP (); | |
a98cef7e KN |
388 | NEXT; |
389 | } | |
390 | ||
e4257331 | 391 | VM_DEFINE_INSTRUCTION (31, long_local_set, "long-local-set", 2, 1, 0) |
a98cef7e | 392 | { |
80545853 AW |
393 | unsigned int i = FETCH (); |
394 | i <<= 8; | |
395 | i += FETCH (); | |
396 | LOCAL_SET (i, *sp); | |
17e90c5e | 397 | DROP (); |
a98cef7e KN |
398 | NEXT; |
399 | } | |
400 | ||
e4257331 | 401 | VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 2, 0) |
a98cef7e | 402 | { |
2d80426a | 403 | VARIABLE_SET (sp[0], sp[-1]); |
11ea1aba | 404 | DROPN (2); |
a98cef7e KN |
405 | NEXT; |
406 | } | |
407 | ||
e4257331 | 408 | VM_DEFINE_INSTRUCTION (33, toplevel_set, "toplevel-set", 1, 1, 0) |
9cc649b8 | 409 | { |
6297d229 | 410 | unsigned objnum = FETCH (); |
fd358575 | 411 | SCM what; |
9cc649b8 | 412 | CHECK_OBJECT (objnum); |
fd358575 | 413 | what = OBJECT_REF (objnum); |
9cc649b8 | 414 | |
fd358575 | 415 | if (!SCM_VARIABLEP (what)) |
9cc649b8 | 416 | { |
6287726a | 417 | SYNC_BEFORE_GC (); |
b7393ea1 | 418 | what = resolve_variable (what, scm_program_module (program)); |
fd358575 | 419 | OBJECT_SET (objnum, what); |
9cc649b8 AW |
420 | } |
421 | ||
fd358575 | 422 | VARIABLE_SET (what, *sp); |
9cc649b8 AW |
423 | DROP (); |
424 | NEXT; | |
425 | } | |
426 | ||
e4257331 | 427 | VM_DEFINE_INSTRUCTION (34, long_toplevel_set, "long-toplevel-set", 2, 1, 0) |
a5cfddd5 AW |
428 | { |
429 | SCM what; | |
430 | unsigned int objnum = FETCH (); | |
431 | objnum <<= 8; | |
432 | objnum += FETCH (); | |
433 | CHECK_OBJECT (objnum); | |
434 | what = OBJECT_REF (objnum); | |
435 | ||
436 | if (!SCM_VARIABLEP (what)) | |
437 | { | |
438 | SYNC_BEFORE_GC (); | |
439 | what = resolve_variable (what, scm_program_module (program)); | |
440 | OBJECT_SET (objnum, what); | |
441 | } | |
442 | ||
443 | VARIABLE_SET (what, *sp); | |
444 | DROP (); | |
445 | NEXT; | |
446 | } | |
447 | ||
a98cef7e KN |
448 | \f |
449 | /* | |
450 | * branch and jump | |
451 | */ | |
452 | ||
97fcf583 | 453 | /* offset must be at least 24 bits wide, and signed */ |
efbd5892 | 454 | #define FETCH_OFFSET(offset) \ |
17e90c5e | 455 | { \ |
97fcf583 AW |
456 | offset = FETCH () << 16; \ |
457 | offset += FETCH () << 8; \ | |
458 | offset += FETCH (); \ | |
459 | offset -= (offset & (1<<23)) << 1; \ | |
efbd5892 AW |
460 | } |
461 | ||
462 | #define BR(p) \ | |
463 | { \ | |
97fcf583 | 464 | scm_t_int32 offset; \ |
efbd5892 | 465 | FETCH_OFFSET (offset); \ |
17e90c5e | 466 | if (p) \ |
97fcf583 | 467 | ip += offset; \ |
5b09b37f AW |
468 | if (offset < 0) \ |
469 | VM_HANDLE_INTERRUPTS; \ | |
11ea1aba | 470 | NULLSTACK (1); \ |
17e90c5e KN |
471 | DROP (); \ |
472 | NEXT; \ | |
473 | } | |
474 | ||
e4257331 | 475 | VM_DEFINE_INSTRUCTION (35, br, "br", 3, 0, 0) |
41f248a8 | 476 | { |
97fcf583 | 477 | scm_t_int32 offset; |
e5dc27b8 | 478 | FETCH_OFFSET (offset); |
97fcf583 | 479 | ip += offset; |
5b09b37f AW |
480 | if (offset < 0) |
481 | VM_HANDLE_INTERRUPTS; | |
41f248a8 KN |
482 | NEXT; |
483 | } | |
484 | ||
e4257331 | 485 | VM_DEFINE_INSTRUCTION (36, br_if, "br-if", 3, 0, 0) |
a98cef7e | 486 | { |
b02b0533 | 487 | BR (scm_is_true_and_not_nil (*sp)); |
a98cef7e KN |
488 | } |
489 | ||
e4257331 | 490 | VM_DEFINE_INSTRUCTION (37, br_if_not, "br-if-not", 3, 0, 0) |
a98cef7e | 491 | { |
b02b0533 | 492 | BR (scm_is_false_or_nil (*sp)); |
a98cef7e KN |
493 | } |
494 | ||
e4257331 | 495 | VM_DEFINE_INSTRUCTION (38, br_if_eq, "br-if-eq", 3, 0, 0) |
a98cef7e | 496 | { |
2c0f99a2 | 497 | sp--; /* underflow? */ |
9bd48cb1 | 498 | BR (scm_is_eq (sp[0], sp[1])); |
a98cef7e KN |
499 | } |
500 | ||
e4257331 | 501 | VM_DEFINE_INSTRUCTION (39, br_if_not_eq, "br-if-not-eq", 3, 0, 0) |
a98cef7e | 502 | { |
2c0f99a2 | 503 | sp--; /* underflow? */ |
9bd48cb1 | 504 | BR (!scm_is_eq (sp[0], sp[1])); |
17e90c5e KN |
505 | } |
506 | ||
e4257331 | 507 | VM_DEFINE_INSTRUCTION (40, br_if_null, "br-if-null", 3, 0, 0) |
17e90c5e | 508 | { |
b02b0533 | 509 | BR (scm_is_null_or_nil (*sp)); |
17e90c5e KN |
510 | } |
511 | ||
e4257331 | 512 | VM_DEFINE_INSTRUCTION (41, br_if_not_null, "br-if-not-null", 3, 0, 0) |
17e90c5e | 513 | { |
b02b0533 | 514 | BR (!scm_is_null_or_nil (*sp)); |
a98cef7e KN |
515 | } |
516 | ||
a98cef7e KN |
517 | \f |
518 | /* | |
519 | * Subprogram call | |
520 | */ | |
521 | ||
e4257331 | 522 | VM_DEFINE_INSTRUCTION (42, br_if_nargs_ne, "br-if-nargs-ne", 5, 0, 0) |
7e01997e AW |
523 | { |
524 | scm_t_ptrdiff n; | |
7f991c7d | 525 | scm_t_int32 offset; |
7e01997e AW |
526 | n = FETCH () << 8; |
527 | n += FETCH (); | |
7e01997e AW |
528 | FETCH_OFFSET (offset); |
529 | if (sp - (fp - 1) != n) | |
530 | ip += offset; | |
531 | NEXT; | |
532 | } | |
533 | ||
e4257331 | 534 | VM_DEFINE_INSTRUCTION (43, br_if_nargs_lt, "br-if-nargs-lt", 5, 0, 0) |
7e01997e AW |
535 | { |
536 | scm_t_ptrdiff n; | |
7f991c7d | 537 | scm_t_int32 offset; |
7e01997e AW |
538 | n = FETCH () << 8; |
539 | n += FETCH (); | |
7e01997e AW |
540 | FETCH_OFFSET (offset); |
541 | if (sp - (fp - 1) < n) | |
542 | ip += offset; | |
543 | NEXT; | |
544 | } | |
545 | ||
e4257331 | 546 | VM_DEFINE_INSTRUCTION (44, br_if_nargs_gt, "br-if-nargs-gt", 5, 0, 0) |
7e01997e AW |
547 | { |
548 | scm_t_ptrdiff n; | |
ff74e44e AW |
549 | scm_t_int32 offset; |
550 | ||
7e01997e AW |
551 | n = FETCH () << 8; |
552 | n += FETCH (); | |
7e01997e AW |
553 | FETCH_OFFSET (offset); |
554 | if (sp - (fp - 1) > n) | |
555 | ip += offset; | |
556 | NEXT; | |
557 | } | |
558 | ||
e4257331 | 559 | VM_DEFINE_INSTRUCTION (45, assert_nargs_ee, "assert-nargs-ee", 2, 0, 0) |
1e2a8c26 AW |
560 | { |
561 | scm_t_ptrdiff n; | |
562 | n = FETCH () << 8; | |
563 | n += FETCH (); | |
a6f15a1e | 564 | if (sp - (fp - 1) != n) |
1e2a8c26 | 565 | goto vm_error_wrong_num_args; |
1e2a8c26 AW |
566 | NEXT; |
567 | } | |
568 | ||
e4257331 | 569 | VM_DEFINE_INSTRUCTION (46, assert_nargs_ge, "assert-nargs-ge", 2, 0, 0) |
1e2a8c26 AW |
570 | { |
571 | scm_t_ptrdiff n; | |
572 | n = FETCH () << 8; | |
573 | n += FETCH (); | |
a6f15a1e | 574 | if (sp - (fp - 1) < n) |
1e2a8c26 | 575 | goto vm_error_wrong_num_args; |
1e2a8c26 AW |
576 | NEXT; |
577 | } | |
578 | ||
e4257331 | 579 | VM_DEFINE_INSTRUCTION (47, bind_optionals, "bind-optionals", 2, -1, -1) |
7e01997e AW |
580 | { |
581 | scm_t_ptrdiff n; | |
582 | n = FETCH () << 8; | |
583 | n += FETCH (); | |
584 | while (sp - (fp - 1) < n) | |
585 | PUSH (SCM_UNDEFINED); | |
586 | NEXT; | |
587 | } | |
588 | ||
e4257331 | 589 | VM_DEFINE_INSTRUCTION (48, bind_optionals_shuffle, "bind-optionals/shuffle", 6, -1, -1) |
7e01997e AW |
590 | { |
591 | SCM *walk; | |
592 | scm_t_ptrdiff nreq, nreq_and_opt, ntotal; | |
593 | nreq = FETCH () << 8; | |
594 | nreq += FETCH (); | |
595 | nreq_and_opt = FETCH () << 8; | |
596 | nreq_and_opt += FETCH (); | |
597 | ntotal = FETCH () << 8; | |
598 | ntotal += FETCH (); | |
599 | ||
600 | /* look in optionals for first keyword or last positional */ | |
601 | /* starting after the last required positional arg */ | |
3092a14d | 602 | walk = fp + nreq; |
7e01997e AW |
603 | while (/* while we have args */ |
604 | walk <= sp | |
605 | /* and we still have positionals to fill */ | |
3092a14d | 606 | && walk - fp < nreq_and_opt |
7e01997e AW |
607 | /* and we haven't reached a keyword yet */ |
608 | && !scm_is_keyword (*walk)) | |
609 | /* bind this optional arg (by leaving it in place) */ | |
610 | walk++; | |
611 | /* now shuffle up, from walk to ntotal */ | |
612 | { | |
3092a14d | 613 | scm_t_ptrdiff nshuf = sp - walk + 1, i; |
7e01997e AW |
614 | sp = (fp - 1) + ntotal + nshuf; |
615 | CHECK_OVERFLOW (); | |
3092a14d AW |
616 | for (i = 0; i < nshuf; i++) |
617 | sp[-i] = walk[nshuf-i-1]; | |
7e01997e AW |
618 | } |
619 | /* and fill optionals & keyword args with SCM_UNDEFINED */ | |
3092a14d | 620 | while (walk <= (fp - 1) + ntotal) |
7e01997e AW |
621 | *walk++ = SCM_UNDEFINED; |
622 | ||
623 | NEXT; | |
624 | } | |
625 | ||
ff74e44e AW |
626 | /* Flags that determine whether other keywords are allowed, and whether a |
627 | rest argument is expected. These values must match those used by the | |
628 | glil->assembly compiler. */ | |
629 | #define F_ALLOW_OTHER_KEYS 1 | |
630 | #define F_REST 2 | |
631 | ||
e4257331 | 632 | VM_DEFINE_INSTRUCTION (49, bind_kwargs, "bind-kwargs", 5, 0, 0) |
7e01997e AW |
633 | { |
634 | scm_t_uint16 idx; | |
635 | scm_t_ptrdiff nkw; | |
ff74e44e | 636 | int kw_and_rest_flags; |
7e01997e AW |
637 | SCM kw; |
638 | idx = FETCH () << 8; | |
639 | idx += FETCH (); | |
ff74e44e | 640 | /* XXX: We don't actually use NKW. */ |
7e01997e AW |
641 | nkw = FETCH () << 8; |
642 | nkw += FETCH (); | |
ff74e44e | 643 | kw_and_rest_flags = FETCH (); |
7e01997e | 644 | |
ff74e44e AW |
645 | if (!(kw_and_rest_flags & F_REST) |
646 | && ((sp - (fp - 1) - nkw) % 2)) | |
7e01997e AW |
647 | goto vm_error_kwargs_length_not_even; |
648 | ||
649 | CHECK_OBJECT (idx); | |
650 | kw = OBJECT_REF (idx); | |
ff74e44e AW |
651 | |
652 | /* Switch NKW to be a negative index below SP. */ | |
653 | for (nkw = -(sp - (fp - 1) - nkw) + 1; nkw < 0; nkw++) | |
7e01997e AW |
654 | { |
655 | SCM walk; | |
ff74e44e AW |
656 | |
657 | if (scm_is_keyword (sp[nkw])) | |
658 | { | |
659 | for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk)) | |
660 | { | |
661 | if (scm_is_eq (SCM_CAAR (walk), sp[nkw])) | |
662 | { | |
663 | SCM si = SCM_CDAR (walk); | |
664 | LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_long (si), | |
665 | sp[nkw + 1]); | |
666 | break; | |
667 | } | |
668 | } | |
669 | if (!(kw_and_rest_flags & F_ALLOW_OTHER_KEYS) && !scm_is_pair (walk)) | |
670 | goto vm_error_kwargs_unrecognized_keyword; | |
671 | ||
672 | nkw++; | |
673 | } | |
674 | else if (!(kw_and_rest_flags & F_REST)) | |
675 | goto vm_error_kwargs_invalid_keyword; | |
7e01997e AW |
676 | } |
677 | ||
678 | NEXT; | |
679 | } | |
680 | ||
ff74e44e AW |
681 | #undef F_ALLOW_OTHER_KEYS |
682 | #undef F_REST | |
683 | ||
684 | ||
e4257331 | 685 | VM_DEFINE_INSTRUCTION (50, push_rest, "push-rest", 2, -1, -1) |
1e2a8c26 AW |
686 | { |
687 | scm_t_ptrdiff n; | |
a6f15a1e | 688 | SCM rest = SCM_EOL; |
1e2a8c26 AW |
689 | n = FETCH () << 8; |
690 | n += FETCH (); | |
a6f15a1e | 691 | while (sp - (fp - 1) > n) |
1e2a8c26 AW |
692 | /* No need to check for underflow. */ |
693 | CONS (rest, *sp--, rest); | |
694 | PUSH (rest); | |
1e2a8c26 AW |
695 | NEXT; |
696 | } | |
697 | ||
e4257331 | 698 | VM_DEFINE_INSTRUCTION (51, bind_rest, "bind-rest", 4, -1, -1) |
899d37a6 AW |
699 | { |
700 | scm_t_ptrdiff n; | |
701 | scm_t_uint32 i; | |
702 | SCM rest = SCM_EOL; | |
703 | n = FETCH () << 8; | |
704 | n += FETCH (); | |
705 | i = FETCH () << 8; | |
706 | i += FETCH (); | |
707 | while (sp - (fp - 1) > n) | |
708 | /* No need to check for underflow. */ | |
709 | CONS (rest, *sp--, rest); | |
710 | LOCAL_SET (i, rest); | |
711 | NEXT; | |
712 | } | |
713 | ||
e4257331 | 714 | VM_DEFINE_INSTRUCTION (52, reserve_locals, "reserve-locals", 2, -1, -1) |
b7946e9e | 715 | { |
258344b4 | 716 | SCM *old_sp; |
55d9bc94 AW |
717 | scm_t_int32 n; |
718 | n = FETCH () << 8; | |
719 | n += FETCH (); | |
258344b4 AW |
720 | old_sp = sp; |
721 | sp = (fp - 1) + n; | |
722 | ||
723 | if (old_sp < sp) | |
724 | { | |
725 | CHECK_OVERFLOW (); | |
726 | while (old_sp < sp) | |
727 | *++old_sp = SCM_UNDEFINED; | |
728 | } | |
729 | else | |
730 | NULLSTACK (old_sp - sp); | |
731 | ||
55d9bc94 AW |
732 | NEXT; |
733 | } | |
734 | ||
e4257331 | 735 | VM_DEFINE_INSTRUCTION (53, new_frame, "new-frame", 0, 0, 3) |
b7946e9e | 736 | { |
6c6a4439 AW |
737 | /* NB: if you change this, see frames.c:vm-frame-num-locals */ |
738 | /* and frames.h, vm-engine.c, etc of course */ | |
b7946e9e AW |
739 | PUSH ((SCM)fp); /* dynamic link */ |
740 | PUSH (0); /* mvra */ | |
741 | PUSH (0); /* ra */ | |
742 | NEXT; | |
743 | } | |
744 | ||
e4257331 | 745 | VM_DEFINE_INSTRUCTION (54, call, "call", 1, -1, 1) |
a98cef7e | 746 | { |
17e90c5e | 747 | nargs = FETCH (); |
a98cef7e KN |
748 | |
749 | vm_call: | |
75c3ed28 | 750 | program = sp[-nargs]; |
c8b9df71 | 751 | |
e8c37772 | 752 | VM_HANDLE_INTERRUPTS; |
e311f5fa | 753 | |
75c3ed28 | 754 | if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) |
a98cef7e | 755 | { |
75c3ed28 | 756 | if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) |
42906d74 | 757 | { |
75c3ed28 AW |
758 | sp[-nargs] = SCM_STRUCT_PROCEDURE (program); |
759 | goto vm_call; | |
760 | } | |
761 | else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob | |
762 | && SCM_SMOB_APPLICABLE_P (program)) | |
763 | { | |
764 | SYNC_REGISTER (); | |
765 | sp[-nargs] = scm_i_smob_apply_trampoline (program); | |
766 | goto vm_call; | |
42906d74 | 767 | } |
23f276de | 768 | else |
75c3ed28 | 769 | goto vm_error_wrong_type_apply; |
a98cef7e | 770 | } |
a98cef7e | 771 | |
75c3ed28 AW |
772 | CACHE_PROGRAM (); |
773 | fp = sp - nargs + 1; | |
774 | ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); | |
775 | ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); | |
776 | SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); | |
777 | SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0); | |
778 | ip = SCM_C_OBJCODE_BASE (bp); | |
779 | ENTER_HOOK (); | |
780 | APPLY_HOOK (); | |
781 | NEXT; | |
a98cef7e KN |
782 | } |
783 | ||
a5bbb22e | 784 | VM_DEFINE_INSTRUCTION (55, tail_call, "tail-call", 1, -1, 1) |
a98cef7e | 785 | { |
17e90c5e | 786 | nargs = FETCH (); |
75c3ed28 | 787 | |
a5bbb22e | 788 | vm_tail_call: |
75c3ed28 | 789 | program = sp[-nargs]; |
17e90c5e | 790 | |
e8c37772 | 791 | VM_HANDLE_INTERRUPTS; |
a98cef7e | 792 | |
75c3ed28 AW |
793 | if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) |
794 | { | |
795 | if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) | |
796 | { | |
797 | sp[-nargs] = SCM_STRUCT_PROCEDURE (program); | |
798 | goto vm_tail_call; | |
799 | } | |
800 | else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob | |
801 | && SCM_SMOB_APPLICABLE_P (program)) | |
802 | { | |
803 | SYNC_REGISTER (); | |
804 | sp[-nargs] = scm_i_smob_apply_trampoline (program); | |
805 | goto vm_tail_call; | |
806 | } | |
807 | else | |
808 | goto vm_error_wrong_type_apply; | |
809 | } | |
810 | else | |
17e90c5e | 811 | { |
28106f54 | 812 | int i; |
11ea1aba | 813 | #ifdef VM_ENABLE_STACK_NULLING |
a6f15a1e AW |
814 | SCM *old_sp = sp; |
815 | CHECK_STACK_LEAK (); | |
11ea1aba | 816 | #endif |
28106f54 | 817 | |
17e90c5e | 818 | EXIT_HOOK (); |
28106f54 | 819 | |
28106f54 | 820 | /* switch programs */ |
28106f54 | 821 | CACHE_PROGRAM (); |
a6f15a1e AW |
822 | /* shuffle down the program and the arguments */ |
823 | for (i = -1, sp = sp - nargs + 1; i < nargs; i++) | |
824 | SCM_FRAME_STACK_ADDRESS (fp)[i] = sp[i]; | |
11ea1aba | 825 | |
03e6c165 | 826 | sp = fp + i - 1; |
28106f54 | 827 | |
11ea1aba AW |
828 | NULLSTACK (old_sp - sp); |
829 | ||
3dbbe28d | 830 | ip = SCM_C_OBJCODE_BASE (bp); |
11ea1aba | 831 | |
28106f54 AW |
832 | ENTER_HOOK (); |
833 | APPLY_HOOK (); | |
834 | NEXT; | |
17e90c5e | 835 | } |
17e90c5e KN |
836 | } |
837 | ||
827dc8dc | 838 | VM_DEFINE_INSTRUCTION (56, subr_call, "subr-call", 1, -1, -1) |
fd629322 AW |
839 | { |
840 | SCM foreign, ret; | |
841 | SCM (*subr)(); | |
842 | nargs = FETCH (); | |
843 | POP (foreign); | |
844 | ||
52fd9639 | 845 | subr = SCM_FOREIGN_POINTER (foreign, void); |
fd629322 AW |
846 | |
847 | VM_HANDLE_INTERRUPTS; | |
848 | SYNC_REGISTER (); | |
849 | ||
850 | switch (nargs) | |
851 | { | |
852 | case 0: | |
853 | ret = subr (); | |
854 | break; | |
855 | case 1: | |
856 | ret = subr (sp[0]); | |
857 | break; | |
858 | case 2: | |
859 | ret = subr (sp[-1], sp[0]); | |
860 | break; | |
861 | case 3: | |
862 | ret = subr (sp[-2], sp[-1], sp[0]); | |
863 | break; | |
864 | case 4: | |
865 | ret = subr (sp[-3], sp[-2], sp[-1], sp[0]); | |
866 | break; | |
867 | case 5: | |
868 | ret = subr (sp[-4], sp[-3], sp[-2], sp[-1], sp[0]); | |
869 | break; | |
870 | case 6: | |
871 | ret = subr (sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]); | |
872 | break; | |
873 | case 7: | |
874 | ret = subr (sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]); | |
875 | break; | |
876 | case 8: | |
877 | ret = subr (sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]); | |
878 | break; | |
879 | case 9: | |
880 | ret = subr (sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]); | |
881 | break; | |
882 | case 10: | |
883 | ret = subr (sp[-9], sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]); | |
884 | break; | |
885 | default: | |
886 | abort (); | |
887 | } | |
888 | ||
889 | NULLSTACK_FOR_NONLOCAL_EXIT (); | |
fd629322 AW |
890 | |
891 | if (SCM_UNLIKELY (SCM_VALUESP (ret))) | |
892 | { | |
893 | /* multiple values returned to continuation */ | |
894 | ret = scm_struct_ref (ret, SCM_INUM0); | |
895 | nvalues = scm_ilength (ret); | |
896 | PUSH_LIST (ret, scm_is_null); | |
897 | goto vm_return_values; | |
898 | } | |
899 | else | |
900 | { | |
901 | PUSH (ret); | |
902 | goto vm_return; | |
903 | } | |
904 | } | |
905 | ||
827dc8dc | 906 | VM_DEFINE_INSTRUCTION (57, smob_call, "smob-call", 1, -1, -1) |
75c3ed28 AW |
907 | { |
908 | SCM smob, ret; | |
909 | SCM (*subr)(); | |
910 | nargs = FETCH (); | |
911 | POP (smob); | |
912 | ||
913 | subr = SCM_SMOB_DESCRIPTOR (smob).apply; | |
914 | ||
915 | VM_HANDLE_INTERRUPTS; | |
916 | SYNC_REGISTER (); | |
917 | ||
918 | switch (nargs) | |
919 | { | |
920 | case 0: | |
921 | ret = subr (smob); | |
922 | break; | |
923 | case 1: | |
924 | ret = subr (smob, sp[0]); | |
925 | break; | |
926 | case 2: | |
927 | ret = subr (smob, sp[-1], sp[0]); | |
928 | break; | |
929 | case 3: | |
930 | ret = subr (smob, sp[-2], sp[-1], sp[0]); | |
931 | break; | |
932 | default: | |
933 | abort (); | |
934 | } | |
935 | ||
936 | NULLSTACK_FOR_NONLOCAL_EXIT (); | |
75c3ed28 AW |
937 | |
938 | if (SCM_UNLIKELY (SCM_VALUESP (ret))) | |
939 | { | |
940 | /* multiple values returned to continuation */ | |
941 | ret = scm_struct_ref (ret, SCM_INUM0); | |
942 | nvalues = scm_ilength (ret); | |
943 | PUSH_LIST (ret, scm_is_null); | |
944 | goto vm_return_values; | |
945 | } | |
946 | else | |
947 | { | |
948 | PUSH (ret); | |
949 | goto vm_return; | |
950 | } | |
951 | } | |
952 | ||
827dc8dc AW |
953 | VM_DEFINE_INSTRUCTION (58, foreign_call, "foreign-call", 1, -1, -1) |
954 | { | |
955 | SCM foreign, ret; | |
956 | nargs = FETCH (); | |
957 | POP (foreign); | |
958 | ||
959 | VM_HANDLE_INTERRUPTS; | |
960 | SYNC_REGISTER (); | |
961 | ||
4d9130a5 | 962 | ret = scm_i_foreign_call (foreign, sp - nargs + 1); |
827dc8dc AW |
963 | |
964 | NULLSTACK_FOR_NONLOCAL_EXIT (); | |
965 | ||
966 | if (SCM_UNLIKELY (SCM_VALUESP (ret))) | |
967 | { | |
968 | /* multiple values returned to continuation */ | |
969 | ret = scm_struct_ref (ret, SCM_INUM0); | |
970 | nvalues = scm_ilength (ret); | |
971 | PUSH_LIST (ret, scm_is_null); | |
972 | goto vm_return_values; | |
973 | } | |
974 | else | |
975 | { | |
976 | PUSH (ret); | |
977 | goto vm_return; | |
978 | } | |
979 | } | |
980 | ||
1d1cae0e AW |
981 | VM_DEFINE_INSTRUCTION (89, continuation_call, "continuation-call", 0, -1, 0) |
982 | { | |
983 | SCM contregs; | |
984 | POP (contregs); | |
d8873dfe | 985 | |
f7cea645 | 986 | SYNC_ALL (); |
d8873dfe AW |
987 | scm_i_check_continuation (contregs); |
988 | vm_return_to_continuation (scm_i_contregs_vm (contregs), | |
989 | scm_i_contregs_vm_cont (contregs), | |
990 | sp - (fp - 1), fp); | |
991 | scm_i_reinstate_continuation (contregs); | |
992 | ||
1d1cae0e AW |
993 | /* no NEXT */ |
994 | abort (); | |
995 | } | |
996 | ||
cee1d22c AW |
997 | VM_DEFINE_INSTRUCTION (94, partial_cont_call, "partial-cont-call", 0, -1, 0) |
998 | { | |
adbdfd6d | 999 | SCM vmcont, intwinds, prevwinds; |
cee1d22c AW |
1000 | POP (intwinds); |
1001 | POP (vmcont); | |
07801437 | 1002 | SYNC_REGISTER (); |
b3950ad6 AW |
1003 | if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont))) |
1004 | { finish_args = vmcont; | |
1005 | goto vm_error_continuation_not_rewindable; | |
1006 | } | |
adbdfd6d AW |
1007 | prevwinds = scm_i_dynwinds (); |
1008 | vm_reinstate_partial_continuation (vm, vmcont, intwinds, sp + 1 - fp, fp, | |
1009 | vm_cookie); | |
1010 | ||
1011 | /* Rewind prompt jmpbuffers, if any. */ | |
1012 | { | |
1013 | SCM winds = scm_i_dynwinds (); | |
1014 | for (; !scm_is_eq (winds, prevwinds); winds = scm_cdr (winds)) | |
1015 | if (SCM_PROMPT_P (scm_car (winds)) && SCM_PROMPT_SETJMP (scm_car (winds))) | |
1016 | break; | |
1017 | } | |
1018 | ||
07801437 AW |
1019 | CACHE_REGISTER (); |
1020 | program = SCM_FRAME_PROGRAM (fp); | |
1021 | CACHE_PROGRAM (); | |
cee1d22c AW |
1022 | NEXT; |
1023 | } | |
1024 | ||
827dc8dc | 1025 | VM_DEFINE_INSTRUCTION (59, tail_call_nargs, "tail-call/nargs", 0, 0, 1) |
efbd5892 AW |
1026 | { |
1027 | SCM x; | |
1028 | POP (x); | |
1029 | nargs = scm_to_int (x); | |
d51406fe | 1030 | /* FIXME: should truncate values? */ |
a5bbb22e | 1031 | goto vm_tail_call; |
efbd5892 AW |
1032 | } |
1033 | ||
827dc8dc | 1034 | VM_DEFINE_INSTRUCTION (60, call_nargs, "call/nargs", 0, 0, 1) |
efbd5892 AW |
1035 | { |
1036 | SCM x; | |
1037 | POP (x); | |
1038 | nargs = scm_to_int (x); | |
d51406fe | 1039 | /* FIXME: should truncate values? */ |
efbd5892 AW |
1040 | goto vm_call; |
1041 | } | |
1042 | ||
827dc8dc | 1043 | VM_DEFINE_INSTRUCTION (61, mv_call, "mv-call", 4, -1, 1) |
a222b0fa | 1044 | { |
97fcf583 | 1045 | scm_t_int32 offset; |
e5dc27b8 | 1046 | scm_t_uint8 *mvra; |
a222b0fa AW |
1047 | |
1048 | nargs = FETCH (); | |
efbd5892 | 1049 | FETCH_OFFSET (offset); |
97fcf583 | 1050 | mvra = ip + offset; |
a222b0fa | 1051 | |
352c87d7 | 1052 | vm_mv_call: |
75c3ed28 | 1053 | program = sp[-nargs]; |
a222b0fa | 1054 | |
7d94e4af AW |
1055 | VM_HANDLE_INTERRUPTS; |
1056 | ||
75c3ed28 | 1057 | if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) |
a222b0fa | 1058 | { |
75c3ed28 AW |
1059 | if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) |
1060 | { | |
1061 | sp[-nargs] = SCM_STRUCT_PROCEDURE (program); | |
1062 | goto vm_mv_call; | |
1063 | } | |
1064 | else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob | |
1065 | && SCM_SMOB_APPLICABLE_P (program)) | |
a222b0fa | 1066 | { |
75c3ed28 AW |
1067 | SYNC_REGISTER (); |
1068 | sp[-nargs] = scm_i_smob_apply_trampoline (program); | |
1069 | goto vm_mv_call; | |
a222b0fa | 1070 | } |
cc8d1f5f | 1071 | else |
75c3ed28 | 1072 | goto vm_error_wrong_type_apply; |
a222b0fa | 1073 | } |
a222b0fa | 1074 | |
75c3ed28 AW |
1075 | CACHE_PROGRAM (); |
1076 | fp = sp - nargs + 1; | |
1077 | ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); | |
1078 | ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); | |
1079 | SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); | |
1080 | SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra); | |
1081 | ip = SCM_C_OBJCODE_BASE (bp); | |
1082 | ENTER_HOOK (); | |
1083 | APPLY_HOOK (); | |
1084 | NEXT; | |
a222b0fa AW |
1085 | } |
1086 | ||
827dc8dc | 1087 | VM_DEFINE_INSTRUCTION (62, apply, "apply", 1, -1, 1) |
3616e9e9 | 1088 | { |
c8b9df71 KN |
1089 | int len; |
1090 | SCM ls; | |
1091 | POP (ls); | |
1092 | ||
1093 | nargs = FETCH (); | |
9a8cc8e7 | 1094 | ASSERT (nargs >= 2); |
c8b9df71 KN |
1095 | |
1096 | len = scm_ilength (ls); | |
1097 | if (len < 0) | |
1098 | goto vm_error_wrong_type_arg; | |
1099 | ||
fb10a008 | 1100 | PUSH_LIST (ls, SCM_NULL_OR_NIL_P); |
c8b9df71 KN |
1101 | |
1102 | nargs += len - 2; | |
1103 | goto vm_call; | |
3616e9e9 KN |
1104 | } |
1105 | ||
827dc8dc | 1106 | VM_DEFINE_INSTRUCTION (63, tail_apply, "tail-apply", 1, -1, 1) |
f03c31db AW |
1107 | { |
1108 | int len; | |
1109 | SCM ls; | |
1110 | POP (ls); | |
1111 | ||
1112 | nargs = FETCH (); | |
9a8cc8e7 | 1113 | ASSERT (nargs >= 2); |
f03c31db AW |
1114 | |
1115 | len = scm_ilength (ls); | |
1116 | if (len < 0) | |
1117 | goto vm_error_wrong_type_arg; | |
1118 | ||
fb10a008 | 1119 | PUSH_LIST (ls, SCM_NULL_OR_NIL_P); |
f03c31db AW |
1120 | |
1121 | nargs += len - 2; | |
a5bbb22e | 1122 | goto vm_tail_call; |
f03c31db AW |
1123 | } |
1124 | ||
827dc8dc | 1125 | VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1) |
17e90c5e | 1126 | { |
76282387 | 1127 | int first; |
d8873dfe | 1128 | SCM proc, vm_cont, cont; |
76282387 AW |
1129 | POP (proc); |
1130 | SYNC_ALL (); | |
cee1d22c | 1131 | vm_cont = scm_i_vm_capture_stack (vp->stack_base, fp, sp, ip, NULL, 0); |
d8873dfe | 1132 | cont = scm_i_make_continuation (&first, vm, vm_cont); |
76282387 AW |
1133 | if (first) |
1134 | { | |
b7946e9e AW |
1135 | PUSH ((SCM)fp); /* dynamic link */ |
1136 | PUSH (0); /* mvra */ | |
1137 | PUSH (0); /* ra */ | |
76282387 AW |
1138 | PUSH (proc); |
1139 | PUSH (cont); | |
1140 | nargs = 1; | |
1141 | goto vm_call; | |
1142 | } | |
d8873dfe | 1143 | else |
76282387 | 1144 | { |
d8873dfe AW |
1145 | /* otherwise, the vm continuation was reinstated, and |
1146 | scm_i_vm_return_to_continuation pushed on one value. So pull our regs | |
1147 | back down from the vp, and march on to the next instruction. */ | |
1148 | CACHE_REGISTER (); | |
1149 | program = SCM_FRAME_PROGRAM (fp); | |
1150 | CACHE_PROGRAM (); | |
76282387 AW |
1151 | NEXT; |
1152 | } | |
a98cef7e KN |
1153 | } |
1154 | ||
827dc8dc | 1155 | VM_DEFINE_INSTRUCTION (65, tail_call_cc, "tail-call/cc", 0, 1, 1) |
f03c31db | 1156 | { |
76282387 | 1157 | int first; |
d8873dfe | 1158 | SCM proc, vm_cont, cont; |
76282387 AW |
1159 | POP (proc); |
1160 | SYNC_ALL (); | |
d8873dfe AW |
1161 | /* In contrast to call/cc, tail-call/cc captures the continuation without the |
1162 | stack frame. */ | |
cee1d22c AW |
1163 | vm_cont = scm_i_vm_capture_stack (vp->stack_base, |
1164 | SCM_FRAME_DYNAMIC_LINK (fp), | |
1165 | SCM_FRAME_LOWER_ADDRESS (fp) - 1, | |
1166 | SCM_FRAME_RETURN_ADDRESS (fp), | |
1167 | SCM_FRAME_MV_RETURN_ADDRESS (fp), | |
1168 | 0); | |
d8873dfe | 1169 | cont = scm_i_make_continuation (&first, vm, vm_cont); |
76282387 AW |
1170 | if (first) |
1171 | { | |
1172 | PUSH (proc); | |
1173 | PUSH (cont); | |
1174 | nargs = 1; | |
a5bbb22e | 1175 | goto vm_tail_call; |
76282387 | 1176 | } |
76282387 AW |
1177 | else |
1178 | { | |
d8873dfe AW |
1179 | /* Otherwise, cache regs and NEXT, as above. Invoking the continuation |
1180 | does a return from the frame, either to the RA or MVRA. */ | |
1181 | CACHE_REGISTER (); | |
1182 | program = SCM_FRAME_PROGRAM (fp); | |
1183 | CACHE_PROGRAM (); | |
1184 | NEXT; | |
76282387 | 1185 | } |
f03c31db AW |
1186 | } |
1187 | ||
827dc8dc | 1188 | VM_DEFINE_INSTRUCTION (66, return, "return", 0, 1, 1) |
a98cef7e | 1189 | { |
a98cef7e | 1190 | vm_return: |
17e90c5e | 1191 | EXIT_HOOK (); |
45cc4867 | 1192 | RETURN_HOOK (1); |
e8c37772 AW |
1193 | |
1194 | VM_HANDLE_INTERRUPTS; | |
1195 | ||
f13c269b | 1196 | { |
03e6c165 | 1197 | SCM ret; |
f13c269b AW |
1198 | |
1199 | POP (ret); | |
6c6a4439 AW |
1200 | |
1201 | #ifdef VM_ENABLE_STACK_NULLING | |
1202 | SCM *old_sp = sp; | |
1203 | #endif | |
f13c269b AW |
1204 | |
1205 | /* Restore registers */ | |
1206 | sp = SCM_FRAME_LOWER_ADDRESS (fp); | |
03e6c165 AW |
1207 | ip = SCM_FRAME_RETURN_ADDRESS (fp); |
1208 | fp = SCM_FRAME_DYNAMIC_LINK (fp); | |
6c6a4439 | 1209 | |
11ea1aba | 1210 | #ifdef VM_ENABLE_STACK_NULLING |
6c6a4439 | 1211 | NULLSTACK (old_sp - sp); |
11ea1aba | 1212 | #endif |
f13c269b AW |
1213 | |
1214 | /* Set return value (sp is already pushed) */ | |
1215 | *sp = ret; | |
1216 | } | |
17e90c5e | 1217 | |
15df3447 | 1218 | /* Restore the last program */ |
af988bbf | 1219 | program = SCM_FRAME_PROGRAM (fp); |
499a4c07 | 1220 | CACHE_PROGRAM (); |
7e4760e4 | 1221 | CHECK_IP (); |
a98cef7e KN |
1222 | NEXT; |
1223 | } | |
17e90c5e | 1224 | |
827dc8dc | 1225 | VM_DEFINE_INSTRUCTION (67, return_values, "return/values", 1, -1, -1) |
a222b0fa | 1226 | { |
ef24c01b AW |
1227 | /* nvalues declared at top level, because for some reason gcc seems to think |
1228 | that perhaps it might be used without declaration. Fooey to that, I say. */ | |
ef24c01b AW |
1229 | nvalues = FETCH (); |
1230 | vm_return_values: | |
a222b0fa | 1231 | EXIT_HOOK (); |
45cc4867 | 1232 | RETURN_HOOK (nvalues); |
ef24c01b | 1233 | |
7d94e4af AW |
1234 | VM_HANDLE_INTERRUPTS; |
1235 | ||
03e6c165 | 1236 | if (nvalues != 1 && SCM_FRAME_MV_RETURN_ADDRESS (fp)) |
ef24c01b | 1237 | { |
6c6a4439 AW |
1238 | /* A multiply-valued continuation */ |
1239 | SCM *vals = sp - nvalues; | |
ef24c01b AW |
1240 | int i; |
1241 | /* Restore registers */ | |
1242 | sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; | |
03e6c165 AW |
1243 | ip = SCM_FRAME_MV_RETURN_ADDRESS (fp); |
1244 | fp = SCM_FRAME_DYNAMIC_LINK (fp); | |
a222b0fa | 1245 | |
ef24c01b AW |
1246 | /* Push return values, and the number of values */ |
1247 | for (i = 0; i < nvalues; i++) | |
6c6a4439 | 1248 | *++sp = vals[i+1]; |
ef24c01b | 1249 | *++sp = SCM_I_MAKINUM (nvalues); |
a222b0fa | 1250 | |
6c6a4439 AW |
1251 | /* Finally null the end of the stack */ |
1252 | NULLSTACK (vals + nvalues - sp); | |
ef24c01b AW |
1253 | } |
1254 | else if (nvalues >= 1) | |
1255 | { | |
1256 | /* Multiple values for a single-valued continuation -- here's where I | |
1257 | break with guile tradition and try and do something sensible. (Also, | |
1258 | this block handles the single-valued return to an mv | |
1259 | continuation.) */ | |
6c6a4439 | 1260 | SCM *vals = sp - nvalues; |
ef24c01b AW |
1261 | /* Restore registers */ |
1262 | sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; | |
03e6c165 AW |
1263 | ip = SCM_FRAME_RETURN_ADDRESS (fp); |
1264 | fp = SCM_FRAME_DYNAMIC_LINK (fp); | |
a222b0fa | 1265 | |
ef24c01b | 1266 | /* Push first value */ |
6c6a4439 | 1267 | *++sp = vals[1]; |
a222b0fa | 1268 | |
6c6a4439 AW |
1269 | /* Finally null the end of the stack */ |
1270 | NULLSTACK (vals + nvalues - sp); | |
ef24c01b AW |
1271 | } |
1272 | else | |
1273 | goto vm_error_no_values; | |
a222b0fa AW |
1274 | |
1275 | /* Restore the last program */ | |
1276 | program = SCM_FRAME_PROGRAM (fp); | |
1277 | CACHE_PROGRAM (); | |
a222b0fa AW |
1278 | CHECK_IP (); |
1279 | NEXT; | |
1280 | } | |
1281 | ||
827dc8dc | 1282 | VM_DEFINE_INSTRUCTION (68, return_values_star, "return/values*", 1, -1, -1) |
ef24c01b AW |
1283 | { |
1284 | SCM l; | |
1285 | ||
1286 | nvalues = FETCH (); | |
11ea1aba | 1287 | ASSERT (nvalues >= 1); |
ef24c01b AW |
1288 | |
1289 | nvalues--; | |
1290 | POP (l); | |
9bd48cb1 | 1291 | while (scm_is_pair (l)) |
ef24c01b AW |
1292 | { |
1293 | PUSH (SCM_CAR (l)); | |
1294 | l = SCM_CDR (l); | |
1295 | nvalues++; | |
1296 | } | |
fb10a008 | 1297 | if (SCM_UNLIKELY (!SCM_NULL_OR_NIL_P (l))) { |
e06e857c | 1298 | finish_args = scm_list_1 (l); |
fb10a008 AW |
1299 | goto vm_error_improper_list; |
1300 | } | |
ef24c01b AW |
1301 | |
1302 | goto vm_return_values; | |
1303 | } | |
1304 | ||
2d9260d1 AW |
1305 | VM_DEFINE_INSTRUCTION (88, return_nvalues, "return/nvalues", 0, 1, -1) |
1306 | { | |
1307 | SCM n; | |
1308 | POP (n); | |
1309 | nvalues = scm_to_int (n); | |
1310 | ASSERT (nvalues >= 0); | |
1311 | goto vm_return_values; | |
1312 | } | |
1313 | ||
827dc8dc | 1314 | VM_DEFINE_INSTRUCTION (69, truncate_values, "truncate-values", 2, -1, -1) |
d51406fe AW |
1315 | { |
1316 | SCM x; | |
1317 | int nbinds, rest; | |
1318 | POP (x); | |
1319 | nvalues = scm_to_int (x); | |
1320 | nbinds = FETCH (); | |
1321 | rest = FETCH (); | |
1322 | ||
1323 | if (rest) | |
1324 | nbinds--; | |
1325 | ||
1326 | if (nvalues < nbinds) | |
1327 | goto vm_error_not_enough_values; | |
1328 | ||
1329 | if (rest) | |
1330 | POP_LIST (nvalues - nbinds); | |
1331 | else | |
1332 | DROPN (nvalues - nbinds); | |
1333 | ||
1334 | NEXT; | |
1335 | } | |
1336 | ||
827dc8dc | 1337 | VM_DEFINE_INSTRUCTION (70, box, "box", 1, 1, 0) |
a9b0f876 | 1338 | { |
8d90b356 AW |
1339 | SCM val; |
1340 | POP (val); | |
1341 | SYNC_BEFORE_GC (); | |
1342 | LOCAL_SET (FETCH (), scm_cell (scm_tc7_variable, SCM_UNPACK (val))); | |
a9b0f876 AW |
1343 | NEXT; |
1344 | } | |
1345 | ||
8d90b356 AW |
1346 | /* for letrec: |
1347 | (let ((a *undef*) (b *undef*) ...) | |
1348 | (set! a (lambda () (b ...))) | |
1349 | ...) | |
1350 | */ | |
827dc8dc | 1351 | VM_DEFINE_INSTRUCTION (71, empty_box, "empty-box", 1, 0, 0) |
a9b0f876 | 1352 | { |
8d90b356 AW |
1353 | SYNC_BEFORE_GC (); |
1354 | LOCAL_SET (FETCH (), | |
1355 | scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED))); | |
1356 | NEXT; | |
1357 | } | |
a9b0f876 | 1358 | |
827dc8dc | 1359 | VM_DEFINE_INSTRUCTION (72, local_boxed_ref, "local-boxed-ref", 1, 0, 1) |
8d90b356 AW |
1360 | { |
1361 | SCM v = LOCAL_REF (FETCH ()); | |
1362 | ASSERT_BOUND_VARIABLE (v); | |
1363 | PUSH (VARIABLE_REF (v)); | |
1364 | NEXT; | |
1365 | } | |
a9b0f876 | 1366 | |
827dc8dc | 1367 | VM_DEFINE_INSTRUCTION (73, local_boxed_set, "local-boxed-set", 1, 1, 0) |
8d90b356 AW |
1368 | { |
1369 | SCM v, val; | |
1370 | v = LOCAL_REF (FETCH ()); | |
1371 | POP (val); | |
1372 | ASSERT_VARIABLE (v); | |
1373 | VARIABLE_SET (v, val); | |
a9b0f876 AW |
1374 | NEXT; |
1375 | } | |
1376 | ||
827dc8dc | 1377 | VM_DEFINE_INSTRUCTION (74, free_ref, "free-ref", 1, 0, 1) |
a9b0f876 | 1378 | { |
8d90b356 AW |
1379 | scm_t_uint8 idx = FETCH (); |
1380 | ||
57ab0671 AW |
1381 | CHECK_FREE_VARIABLE (idx); |
1382 | PUSH (FREE_VARIABLE_REF (idx)); | |
8d90b356 AW |
1383 | NEXT; |
1384 | } | |
a9b0f876 | 1385 | |
57ab0671 | 1386 | /* no free-set -- if a var is assigned, it should be in a box */ |
a9b0f876 | 1387 | |
827dc8dc | 1388 | VM_DEFINE_INSTRUCTION (75, free_boxed_ref, "free-boxed-ref", 1, 0, 1) |
8d90b356 AW |
1389 | { |
1390 | SCM v; | |
1391 | scm_t_uint8 idx = FETCH (); | |
57ab0671 AW |
1392 | CHECK_FREE_VARIABLE (idx); |
1393 | v = FREE_VARIABLE_REF (idx); | |
8d90b356 AW |
1394 | ASSERT_BOUND_VARIABLE (v); |
1395 | PUSH (VARIABLE_REF (v)); | |
1396 | NEXT; | |
1397 | } | |
1398 | ||
827dc8dc | 1399 | VM_DEFINE_INSTRUCTION (76, free_boxed_set, "free-boxed-set", 1, 1, 0) |
8d90b356 AW |
1400 | { |
1401 | SCM v, val; | |
1402 | scm_t_uint8 idx = FETCH (); | |
1403 | POP (val); | |
57ab0671 AW |
1404 | CHECK_FREE_VARIABLE (idx); |
1405 | v = FREE_VARIABLE_REF (idx); | |
8d90b356 AW |
1406 | ASSERT_BOUND_VARIABLE (v); |
1407 | VARIABLE_SET (v, val); | |
1408 | NEXT; | |
1409 | } | |
1410 | ||
827dc8dc | 1411 | VM_DEFINE_INSTRUCTION (77, make_closure, "make-closure", 2, -1, 1) |
8d90b356 | 1412 | { |
6f16379e AW |
1413 | size_t n, len; |
1414 | SCM closure; | |
1415 | ||
1416 | len = FETCH (); | |
1417 | len <<= 8; | |
1418 | len += FETCH (); | |
8d90b356 | 1419 | SYNC_BEFORE_GC (); |
6f16379e AW |
1420 | closure = scm_words (scm_tc7_program | (len<<16), len + 3); |
1421 | SCM_SET_CELL_OBJECT_1 (closure, SCM_PROGRAM_OBJCODE (sp[-len])); | |
1422 | SCM_SET_CELL_OBJECT_2 (closure, SCM_PROGRAM_OBJTABLE (sp[-len])); | |
1423 | sp[-len] = closure; | |
1424 | for (n = 0; n < len; n++) | |
1425 | SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, sp[-len + 1 + n]); | |
1426 | DROPN (len); | |
a9b0f876 AW |
1427 | NEXT; |
1428 | } | |
1429 | ||
827dc8dc | 1430 | VM_DEFINE_INSTRUCTION (78, make_variable, "make-variable", 0, 0, 1) |
80545853 AW |
1431 | { |
1432 | SYNC_BEFORE_GC (); | |
1433 | /* fixme underflow */ | |
1434 | PUSH (scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED))); | |
1435 | NEXT; | |
1436 | } | |
1437 | ||
827dc8dc | 1438 | VM_DEFINE_INSTRUCTION (79, fix_closure, "fix-closure", 2, -1, 0) |
c21c89b1 | 1439 | { |
6f16379e | 1440 | SCM x; |
c21c89b1 | 1441 | unsigned int i = FETCH (); |
6f16379e | 1442 | size_t n, len; |
c21c89b1 AW |
1443 | i <<= 8; |
1444 | i += FETCH (); | |
c21c89b1 AW |
1445 | /* FIXME CHECK_LOCAL (i) */ |
1446 | x = LOCAL_REF (i); | |
1447 | /* FIXME ASSERT_PROGRAM (x); */ | |
6f16379e AW |
1448 | len = SCM_PROGRAM_NUM_FREE_VARIABLES (x); |
1449 | for (n = 0; n < len; n++) | |
1450 | SCM_PROGRAM_FREE_VARIABLE_SET (x, n, sp[-len + 1 + n]); | |
1451 | DROPN (len); | |
c21c89b1 AW |
1452 | NEXT; |
1453 | } | |
1454 | ||
827dc8dc | 1455 | VM_DEFINE_INSTRUCTION (80, define, "define", 0, 0, 2) |
94ff26b9 AW |
1456 | { |
1457 | SCM sym, val; | |
1458 | POP (sym); | |
1459 | POP (val); | |
1460 | SYNC_REGISTER (); | |
1461 | VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (), | |
1462 | SCM_BOOL_T), | |
1463 | val); | |
1464 | NEXT; | |
1465 | } | |
1466 | ||
827dc8dc | 1467 | VM_DEFINE_INSTRUCTION (81, make_keyword, "make-keyword", 0, 1, 1) |
94ff26b9 AW |
1468 | { |
1469 | CHECK_UNDERFLOW (); | |
1470 | SYNC_REGISTER (); | |
1471 | *sp = scm_symbol_to_keyword (*sp); | |
1472 | NEXT; | |
1473 | } | |
1474 | ||
827dc8dc | 1475 | VM_DEFINE_INSTRUCTION (82, make_symbol, "make-symbol", 0, 1, 1) |
94ff26b9 AW |
1476 | { |
1477 | CHECK_UNDERFLOW (); | |
1478 | SYNC_REGISTER (); | |
1479 | *sp = scm_string_to_symbol (*sp); | |
1480 | NEXT; | |
1481 | } | |
1482 | ||
ea6b18e8 | 1483 | VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 4, 2, 0) |
4f66bcde AW |
1484 | { |
1485 | scm_t_int32 offset; | |
ea6b18e8 | 1486 | scm_t_uint8 escape_only_p; |
747022e4 | 1487 | SCM k, prompt; |
4f66bcde | 1488 | |
4f66bcde AW |
1489 | escape_only_p = FETCH (); |
1490 | FETCH_OFFSET (offset); | |
4f66bcde AW |
1491 | POP (k); |
1492 | ||
1493 | SYNC_REGISTER (); | |
d2964315 | 1494 | /* Push the prompt onto the dynamic stack. */ |
adbdfd6d AW |
1495 | prompt = scm_c_make_prompt (k, fp, sp, ip + offset, escape_only_p, vm_cookie, |
1496 | scm_i_dynwinds ()); | |
1497 | scm_i_set_dynwinds (scm_cons (prompt, SCM_PROMPT_DYNWINDS (prompt))); | |
adaf86ec | 1498 | if (SCM_PROMPT_SETJMP (prompt)) |
4f66bcde AW |
1499 | { |
1500 | /* The prompt exited nonlocally. Cache the regs back from the vp, and go | |
ea6b18e8 | 1501 | to the handler. |
d2964315 AW |
1502 | |
1503 | Note, at this point, we must assume that any variable local to | |
1504 | vm_engine that can be assigned *has* been assigned. So we need to pull | |
1505 | all our state back from the ip/fp/sp. | |
ea6b18e8 | 1506 | */ |
d2964315 AW |
1507 | CACHE_REGISTER (); |
1508 | program = SCM_FRAME_PROGRAM (fp); | |
1509 | CACHE_PROGRAM (); | |
4f66bcde AW |
1510 | NEXT; |
1511 | } | |
1512 | ||
1513 | /* Otherwise setjmp returned for the first time, so we go to execute the | |
1514 | prompt's body. */ | |
1515 | NEXT; | |
1516 | } | |
1517 | ||
1518 | VM_DEFINE_INSTRUCTION (85, wind, "wind", 0, 2, 0) | |
1519 | { | |
1520 | SCM wind, unwind; | |
1521 | POP (unwind); | |
1522 | POP (wind); | |
1523 | SYNC_REGISTER (); | |
1524 | /* Push wind and unwind procedures onto the dynamic stack. Note that neither | |
1525 | are actually called; the compiler should emit calls to wind and unwind for | |
1526 | the normal dynamic-wind control flow. */ | |
1527 | if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (wind)))) | |
1528 | { | |
1529 | finish_args = wind; | |
1530 | goto vm_error_not_a_thunk; | |
1531 | } | |
1532 | if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (unwind)))) | |
1533 | { | |
1534 | finish_args = unwind; | |
1535 | goto vm_error_not_a_thunk; | |
1536 | } | |
1537 | scm_i_set_dynwinds (scm_cons (scm_cons (wind, unwind), scm_i_dynwinds ())); | |
1538 | NEXT; | |
1539 | } | |
1540 | ||
6e84cb95 | 1541 | VM_DEFINE_INSTRUCTION (86, abort, "abort", 1, -1, -1) |
4f66bcde AW |
1542 | { |
1543 | unsigned n = FETCH (); | |
4f66bcde | 1544 | SYNC_REGISTER (); |
2d026f04 | 1545 | if (sp - n - 2 <= SCM_FRAME_UPPER_ADDRESS (fp)) |
eaefabee | 1546 | goto vm_error_stack_underflow; |
cee1d22c | 1547 | vm_abort (vm, n, vm_cookie); |
6e84cb95 | 1548 | /* vm_abort should not return */ |
4f66bcde AW |
1549 | abort (); |
1550 | } | |
1551 | ||
1552 | VM_DEFINE_INSTRUCTION (87, unwind, "unwind", 0, 0, 0) | |
1553 | { | |
1554 | /* A normal exit from the dynamic extent of an expression. Pop the top entry | |
1555 | off of the dynamic stack. */ | |
1556 | scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ())); | |
1557 | NEXT; | |
1558 | } | |
1559 | ||
e084b27e AW |
1560 | VM_DEFINE_INSTRUCTION (90, wind_fluids, "wind-fluids", 1, -1, 0) |
1561 | { | |
1562 | unsigned n = FETCH (); | |
1563 | SCM wf; | |
1564 | ||
1565 | if (sp - 2*n < SCM_FRAME_UPPER_ADDRESS (fp)) | |
1566 | goto vm_error_stack_underflow; | |
1567 | ||
f7cea645 | 1568 | SYNC_REGISTER (); |
e084b27e | 1569 | wf = scm_i_make_with_fluids (n, sp + 1 - 2*n, sp + 1 - n); |
26e6f99f | 1570 | scm_i_swap_with_fluids (wf, dynstate); |
e084b27e AW |
1571 | scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ())); |
1572 | NEXT; | |
1573 | } | |
1574 | ||
1575 | VM_DEFINE_INSTRUCTION (91, unwind_fluids, "unwind-fluids", 0, 0, 0) | |
1576 | { | |
1577 | SCM wf; | |
1578 | wf = scm_car (scm_i_dynwinds ()); | |
1579 | scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ())); | |
26e6f99f | 1580 | scm_i_swap_with_fluids (wf, dynstate); |
e084b27e AW |
1581 | NEXT; |
1582 | } | |
4f66bcde | 1583 | |
1e7a0337 AW |
1584 | VM_DEFINE_INSTRUCTION (92, fluid_ref, "fluid-ref", 0, 1, 1) |
1585 | { | |
1586 | size_t num; | |
1587 | SCM fluids; | |
1588 | ||
1589 | CHECK_UNDERFLOW (); | |
1590 | fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate); | |
1591 | if (SCM_UNLIKELY (!SCM_I_FLUID_P (*sp)) | |
1592 | || ((num = SCM_I_FLUID_NUM (*sp)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids))) | |
1593 | { | |
1594 | /* Punt dynstate expansion and error handling to the C proc. */ | |
1595 | SYNC_REGISTER (); | |
1596 | *sp = scm_fluid_ref (*sp); | |
1597 | } | |
1598 | else | |
1599 | *sp = SCM_SIMPLE_VECTOR_REF (fluids, num); | |
1600 | ||
1601 | NEXT; | |
1602 | } | |
1603 | ||
1604 | VM_DEFINE_INSTRUCTION (93, fluid_set, "fluid-set", 0, 2, 0) | |
1605 | { | |
1606 | size_t num; | |
1607 | SCM val, fluid, fluids; | |
1608 | ||
1609 | POP (val); | |
1610 | POP (fluid); | |
1611 | fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate); | |
1612 | if (SCM_UNLIKELY (!SCM_I_FLUID_P (fluid)) | |
1613 | || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids))) | |
1614 | { | |
1615 | /* Punt dynstate expansion and error handling to the C proc. */ | |
1616 | SYNC_REGISTER (); | |
1617 | scm_fluid_set_x (fluid, val); | |
1618 | } | |
1619 | else | |
1620 | SCM_SIMPLE_VECTOR_SET (fluids, num, val); | |
1621 | ||
1622 | NEXT; | |
1623 | } | |
1624 | ||
8d90b356 | 1625 | |
53e28ed9 AW |
1626 | /* |
1627 | (defun renumber-ops () | |
1628 | "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" | |
1629 | (interactive "") | |
1630 | (save-excursion | |
1631 | (let ((counter -1)) (goto-char (point-min)) | |
1632 | (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t) | |
1633 | (replace-match | |
1634 | (number-to-string (setq counter (1+ counter))) | |
1635 | t t nil 1))))) | |
ff810079 | 1636 | (renumber-ops) |
53e28ed9 | 1637 | */ |
17e90c5e KN |
1638 | /* |
1639 | Local Variables: | |
1640 | c-file-style: "gnu" | |
1641 | End: | |
1642 | */ |