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