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