Commit | Line | Data |
---|---|---|
53e28ed9 | 1 | /* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc. |
a98cef7e | 2 | * |
53e28ed9 AW |
3 | * This library is free software; you can redistribute it and/or |
4 | * modify it under the terms of the GNU Lesser General Public | |
5 | * License as published by the Free Software Foundation; either | |
6 | * version 2.1 of the License, or (at your option) any later version. | |
a98cef7e | 7 | * |
53e28ed9 AW |
8 | * This library is distributed in the hope that it will be useful, |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
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 | |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
16 | */ | |
17 | ||
a98cef7e KN |
18 | |
19 | /* This file is included in vm_engine.c */ | |
20 | ||
a98cef7e KN |
21 | \f |
22 | /* | |
23 | * Basic operations | |
24 | */ | |
25 | ||
53e28ed9 | 26 | VM_DEFINE_INSTRUCTION (0, nop, "nop", 0, 0, 0) |
a98cef7e KN |
27 | { |
28 | NEXT; | |
29 | } | |
30 | ||
53e28ed9 | 31 | VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0) |
a98cef7e | 32 | { |
3d5ee0cd | 33 | vp->time += scm_c_get_internal_run_time () - start_time; |
17e90c5e | 34 | HALT_HOOK (); |
a222b0fa | 35 | nvalues = SCM_I_INUM (*sp--); |
11ea1aba | 36 | NULLSTACK (1); |
a222b0fa | 37 | if (nvalues == 1) |
e06e857c | 38 | POP (finish_args); |
a222b0fa AW |
39 | else |
40 | { | |
41 | POP_LIST (nvalues); | |
e06e857c | 42 | POP (finish_args); |
877ffa3f | 43 | SYNC_REGISTER (); |
e06e857c | 44 | finish_args = scm_values (finish_args); |
a222b0fa AW |
45 | } |
46 | ||
1dc8f851 | 47 | { |
11ea1aba AW |
48 | ASSERT (sp == stack_base); |
49 | ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1); | |
1dc8f851 AW |
50 | |
51 | /* Restore registers */ | |
52 | sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; | |
53 | ip = NULL; | |
54 | fp = SCM_FRAME_DYNAMIC_LINK (fp); | |
11ea1aba | 55 | NULLSTACK (stack_base - sp); |
1dc8f851 | 56 | } |
e06e857c AW |
57 | |
58 | goto vm_done; | |
a98cef7e KN |
59 | } |
60 | ||
53e28ed9 | 61 | VM_DEFINE_INSTRUCTION (2, break, "break", 0, 0, 0) |
7a0d0cee KN |
62 | { |
63 | BREAK_HOOK (); | |
64 | NEXT; | |
65 | } | |
66 | ||
131f7d6c | 67 | VM_DEFINE_INSTRUCTION (3, drop, "drop", 0, 1, 0) |
a98cef7e | 68 | { |
17e90c5e | 69 | DROP (); |
a98cef7e KN |
70 | NEXT; |
71 | } | |
72 | ||
53e28ed9 | 73 | VM_DEFINE_INSTRUCTION (4, mark, "mark", 0, 0, 1) |
cb4cca12 KN |
74 | { |
75 | PUSH (SCM_UNDEFINED); | |
76 | NEXT; | |
77 | } | |
78 | ||
53e28ed9 | 79 | VM_DEFINE_INSTRUCTION (5, dup, "dup", 0, 0, 1) |
26403690 | 80 | { |
f349065e KN |
81 | SCM x = *sp; |
82 | PUSH (x); | |
26403690 KN |
83 | NEXT; |
84 | } | |
85 | ||
17e90c5e KN |
86 | \f |
87 | /* | |
88 | * Object creation | |
89 | */ | |
a98cef7e | 90 | |
53e28ed9 | 91 | VM_DEFINE_INSTRUCTION (6, void, "void", 0, 0, 1) |
a98cef7e | 92 | { |
17e90c5e | 93 | PUSH (SCM_UNSPECIFIED); |
a98cef7e KN |
94 | NEXT; |
95 | } | |
96 | ||
53e28ed9 | 97 | VM_DEFINE_INSTRUCTION (7, make_true, "make-true", 0, 0, 1) |
a98cef7e | 98 | { |
17e90c5e | 99 | PUSH (SCM_BOOL_T); |
a98cef7e KN |
100 | NEXT; |
101 | } | |
102 | ||
53e28ed9 | 103 | VM_DEFINE_INSTRUCTION (8, make_false, "make-false", 0, 0, 1) |
a98cef7e | 104 | { |
17e90c5e | 105 | PUSH (SCM_BOOL_F); |
a98cef7e KN |
106 | NEXT; |
107 | } | |
108 | ||
53e28ed9 | 109 | VM_DEFINE_INSTRUCTION (9, make_eol, "make-eol", 0, 0, 1) |
a98cef7e | 110 | { |
17e90c5e | 111 | PUSH (SCM_EOL); |
a98cef7e KN |
112 | NEXT; |
113 | } | |
114 | ||
53e28ed9 | 115 | VM_DEFINE_INSTRUCTION (10, make_int8, "make-int8", 1, 0, 1) |
a98cef7e | 116 | { |
2d80426a | 117 | PUSH (SCM_I_MAKINUM ((signed char) FETCH ())); |
a98cef7e KN |
118 | NEXT; |
119 | } | |
120 | ||
53e28ed9 | 121 | VM_DEFINE_INSTRUCTION (11, make_int8_0, "make-int8:0", 0, 0, 1) |
a98cef7e | 122 | { |
238e7a11 | 123 | PUSH (SCM_INUM0); |
a98cef7e KN |
124 | NEXT; |
125 | } | |
126 | ||
53e28ed9 | 127 | VM_DEFINE_INSTRUCTION (12, make_int8_1, "make-int8:1", 0, 0, 1) |
a98cef7e | 128 | { |
238e7a11 | 129 | PUSH (SCM_I_MAKINUM (1)); |
a98cef7e KN |
130 | NEXT; |
131 | } | |
132 | ||
53e28ed9 | 133 | VM_DEFINE_INSTRUCTION (13, make_int16, "make-int16", 2, 0, 1) |
a98cef7e | 134 | { |
ea9b4b29 KN |
135 | int h = FETCH (); |
136 | int l = FETCH (); | |
2d80426a | 137 | PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l)); |
a98cef7e KN |
138 | NEXT; |
139 | } | |
140 | ||
53e28ed9 | 141 | VM_DEFINE_INSTRUCTION (14, make_char8, "make-char8", 1, 0, 1) |
a98cef7e | 142 | { |
17e90c5e | 143 | PUSH (SCM_MAKE_CHAR (FETCH ())); |
a98cef7e KN |
144 | NEXT; |
145 | } | |
146 | ||
53e28ed9 | 147 | VM_DEFINE_INSTRUCTION (15, list, "list", 2, -1, 1) |
cb4cca12 | 148 | { |
23b587b0 LC |
149 | unsigned h = FETCH (); |
150 | unsigned l = FETCH (); | |
151 | unsigned len = ((h << 8) + l); | |
152 | POP_LIST (len); | |
cb4cca12 KN |
153 | NEXT; |
154 | } | |
155 | ||
53e28ed9 | 156 | VM_DEFINE_INSTRUCTION (16, vector, "vector", 2, -1, 1) |
cb4cca12 | 157 | { |
23b587b0 LC |
158 | unsigned h = FETCH (); |
159 | unsigned l = FETCH (); | |
160 | unsigned len = ((h << 8) + l); | |
5338b62b AW |
161 | SCM vect; |
162 | ||
877ffa3f | 163 | SYNC_REGISTER (); |
5338b62b AW |
164 | sp++; sp -= len; |
165 | CHECK_UNDERFLOW (); | |
166 | vect = scm_make_vector (scm_from_uint (len), SCM_BOOL_F); | |
167 | memcpy (SCM_I_VECTOR_WELTS(vect), sp, sizeof(SCM) * len); | |
168 | NULLSTACK (len); | |
169 | *sp = vect; | |
170 | ||
cb4cca12 KN |
171 | NEXT; |
172 | } | |
173 | ||
53e28ed9 | 174 | VM_DEFINE_INSTRUCTION (17, list_mark, "list-mark", 0, 0, 0) |
cb4cca12 KN |
175 | { |
176 | POP_LIST_MARK (); | |
177 | NEXT; | |
178 | } | |
179 | ||
53e28ed9 | 180 | VM_DEFINE_INSTRUCTION (18, cons_mark, "cons-mark", 0, 0, 0) |
2bd859c8 AW |
181 | { |
182 | POP_CONS_MARK (); | |
183 | NEXT; | |
184 | } | |
185 | ||
53e28ed9 | 186 | VM_DEFINE_INSTRUCTION (19, vector_mark, "vector-mark", 0, 0, 0) |
cb4cca12 KN |
187 | { |
188 | POP_LIST_MARK (); | |
877ffa3f | 189 | SYNC_REGISTER (); |
cb4cca12 KN |
190 | *sp = scm_vector (*sp); |
191 | NEXT; | |
192 | } | |
193 | ||
53e28ed9 | 194 | VM_DEFINE_INSTRUCTION (20, list_break, "list-break", 0, 0, 0) |
cb4cca12 KN |
195 | { |
196 | SCM l; | |
197 | POP (l); | |
fb10a008 | 198 | PUSH_LIST (l, SCM_NULLP); |
cb4cca12 KN |
199 | NEXT; |
200 | } | |
201 | ||
a98cef7e KN |
202 | \f |
203 | /* | |
17e90c5e | 204 | * Variable access |
a98cef7e KN |
205 | */ |
206 | ||
17e90c5e KN |
207 | #define OBJECT_REF(i) objects[i] |
208 | #define OBJECT_SET(i,o) objects[i] = o | |
a98cef7e | 209 | |
af988bbf KN |
210 | #define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i) |
211 | #define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o | |
a98cef7e | 212 | |
2d80426a LC |
213 | /* For the variable operations, we _must_ obviously avoid function calls to |
214 | `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do | |
215 | nothing more than the corresponding macros. */ | |
216 | #define VARIABLE_REF(v) SCM_VARIABLE_REF (v) | |
217 | #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) | |
218 | #define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED) | |
a98cef7e | 219 | |
17e90c5e | 220 | /* ref */ |
a98cef7e | 221 | |
53e28ed9 | 222 | VM_DEFINE_INSTRUCTION (21, object_ref, "object-ref", 1, 0, 1) |
a98cef7e | 223 | { |
a52b2d3d | 224 | register unsigned objnum = FETCH (); |
0b5f0e49 LC |
225 | CHECK_OBJECT (objnum); |
226 | PUSH (OBJECT_REF (objnum)); | |
17e90c5e | 227 | NEXT; |
a98cef7e KN |
228 | } |
229 | ||
53e28ed9 | 230 | VM_DEFINE_INSTRUCTION (22, local_ref, "local-ref", 1, 0, 1) |
a98cef7e | 231 | { |
17e90c5e | 232 | PUSH (LOCAL_REF (FETCH ())); |
a1a482e0 | 233 | ASSERT_BOUND (*sp); |
17e90c5e | 234 | NEXT; |
a98cef7e KN |
235 | } |
236 | ||
53e28ed9 | 237 | VM_DEFINE_INSTRUCTION (23, external_ref, "external-ref", 1, 0, 1) |
a98cef7e | 238 | { |
17e90c5e KN |
239 | unsigned int i; |
240 | SCM e = external; | |
241 | for (i = FETCH (); i; i--) | |
2a63758b KN |
242 | { |
243 | CHECK_EXTERNAL(e); | |
244 | e = SCM_CDR (e); | |
245 | } | |
246 | CHECK_EXTERNAL(e); | |
17e90c5e | 247 | PUSH (SCM_CAR (e)); |
a1a482e0 | 248 | ASSERT_BOUND (*sp); |
a98cef7e KN |
249 | NEXT; |
250 | } | |
251 | ||
53e28ed9 | 252 | VM_DEFINE_INSTRUCTION (24, variable_ref, "variable-ref", 0, 0, 1) |
a98cef7e | 253 | { |
17e90c5e | 254 | SCM x = *sp; |
238e7a11 | 255 | |
2d80426a | 256 | if (!VARIABLE_BOUNDP (x)) |
17e90c5e | 257 | { |
da8b4747 | 258 | finish_args = scm_list_1 (x); |
e06e857c | 259 | /* Was: finish_args = SCM_LIST1 (SCM_CAR (x)); */ |
17e90c5e KN |
260 | goto vm_error_unbound; |
261 | } | |
238e7a11 LC |
262 | else |
263 | { | |
2d80426a | 264 | SCM o = VARIABLE_REF (x); |
238e7a11 LC |
265 | *sp = o; |
266 | } | |
267 | ||
a98cef7e KN |
268 | NEXT; |
269 | } | |
270 | ||
53e28ed9 | 271 | VM_DEFINE_INSTRUCTION (25, toplevel_ref, "toplevel-ref", 1, 0, 1) |
9cc649b8 | 272 | { |
6297d229 | 273 | unsigned objnum = FETCH (); |
fd358575 | 274 | SCM what; |
9cc649b8 | 275 | CHECK_OBJECT (objnum); |
fd358575 | 276 | what = OBJECT_REF (objnum); |
9cc649b8 | 277 | |
fd358575 | 278 | if (!SCM_VARIABLEP (what)) |
9cc649b8 | 279 | { |
d0168f3d | 280 | SYNC_REGISTER (); |
fd358575 | 281 | if (SCM_LIKELY (SCM_SYMBOLP (what))) |
3aabb7b7 | 282 | { |
4054d931 | 283 | SCM mod = SCM_EOL; |
fd358575 | 284 | if (SCM_LIKELY (scm_module_system_booted_p |
2fda0242 | 285 | && scm_is_true ((mod = scm_program_module (program))))) |
fd358575 | 286 | /* might longjmp */ |
2fda0242 | 287 | what = scm_module_lookup (mod, what); |
fd358575 | 288 | else |
196b4093 AW |
289 | { |
290 | SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F); | |
291 | if (scm_is_false (v)) | |
292 | SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (what)); | |
293 | else | |
294 | what = v; | |
295 | } | |
3aabb7b7 AW |
296 | } |
297 | else | |
298 | { | |
fd358575 AW |
299 | SCM mod; |
300 | /* compilation of @ or @@ | |
301 | `what' is a three-element list: (MODNAME SYM INTERFACE?) | |
302 | INTERFACE? is #t if we compiled @ or #f if we compiled @@ | |
303 | */ | |
304 | mod = scm_resolve_module (SCM_CAR (what)); | |
305 | if (scm_is_true (SCM_CADDR (what))) | |
306 | mod = scm_module_public_interface (mod); | |
307 | if (SCM_FALSEP (mod)) | |
308 | { | |
da8b4747 | 309 | finish_args = scm_list_1 (mod); |
fd358575 AW |
310 | goto vm_error_no_such_module; |
311 | } | |
312 | /* might longjmp */ | |
313 | what = scm_module_lookup (mod, SCM_CADR (what)); | |
3aabb7b7 AW |
314 | } |
315 | ||
fd358575 | 316 | if (!VARIABLE_BOUNDP (what)) |
9cc649b8 | 317 | { |
da8b4747 | 318 | finish_args = scm_list_1 (what); |
9cc649b8 AW |
319 | goto vm_error_unbound; |
320 | } | |
3aabb7b7 | 321 | |
fd358575 | 322 | OBJECT_SET (objnum, what); |
9cc649b8 AW |
323 | } |
324 | ||
fd358575 | 325 | PUSH (VARIABLE_REF (what)); |
9cc649b8 AW |
326 | NEXT; |
327 | } | |
328 | ||
17e90c5e KN |
329 | /* set */ |
330 | ||
53e28ed9 | 331 | VM_DEFINE_INSTRUCTION (26, local_set, "local-set", 1, 1, 0) |
a98cef7e | 332 | { |
17e90c5e KN |
333 | LOCAL_SET (FETCH (), *sp); |
334 | DROP (); | |
a98cef7e KN |
335 | NEXT; |
336 | } | |
337 | ||
53e28ed9 | 338 | VM_DEFINE_INSTRUCTION (27, external_set, "external-set", 1, 1, 0) |
a98cef7e | 339 | { |
17e90c5e KN |
340 | unsigned int i; |
341 | SCM e = external; | |
342 | for (i = FETCH (); i; i--) | |
ac02b386 KN |
343 | { |
344 | CHECK_EXTERNAL(e); | |
345 | e = SCM_CDR (e); | |
346 | } | |
347 | CHECK_EXTERNAL(e); | |
17e90c5e KN |
348 | SCM_SETCAR (e, *sp); |
349 | DROP (); | |
a98cef7e KN |
350 | NEXT; |
351 | } | |
352 | ||
53e28ed9 | 353 | VM_DEFINE_INSTRUCTION (28, variable_set, "variable-set", 0, 1, 0) |
a98cef7e | 354 | { |
2d80426a | 355 | VARIABLE_SET (sp[0], sp[-1]); |
11ea1aba | 356 | DROPN (2); |
a98cef7e KN |
357 | NEXT; |
358 | } | |
359 | ||
53e28ed9 | 360 | VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0) |
9cc649b8 | 361 | { |
6297d229 | 362 | unsigned objnum = FETCH (); |
fd358575 | 363 | SCM what; |
9cc649b8 | 364 | CHECK_OBJECT (objnum); |
fd358575 | 365 | what = OBJECT_REF (objnum); |
9cc649b8 | 366 | |
fd358575 | 367 | if (!SCM_VARIABLEP (what)) |
9cc649b8 | 368 | { |
6287726a | 369 | SYNC_BEFORE_GC (); |
fd358575 | 370 | if (SCM_LIKELY (SCM_SYMBOLP (what))) |
3aabb7b7 | 371 | { |
4054d931 | 372 | SCM mod = SCM_EOL; |
fd358575 | 373 | if (SCM_LIKELY (scm_module_system_booted_p |
2fda0242 | 374 | && scm_is_true ((mod = scm_program_module (program))))) |
fd358575 | 375 | /* might longjmp */ |
2fda0242 | 376 | what = scm_module_lookup (mod, what); |
fd358575 | 377 | else |
196b4093 AW |
378 | { |
379 | SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F); | |
380 | if (scm_is_false (v)) | |
381 | SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (what)); | |
382 | else | |
383 | what = v; | |
384 | } | |
3aabb7b7 AW |
385 | } |
386 | else | |
387 | { | |
fd358575 AW |
388 | SCM mod; |
389 | /* compilation of @ or @@ | |
390 | `what' is a three-element list: (MODNAME SYM INTERFACE?) | |
391 | INTERFACE? is #t if we compiled @ or #f if we compiled @@ | |
392 | */ | |
393 | mod = scm_resolve_module (SCM_CAR (what)); | |
394 | if (scm_is_true (SCM_CADDR (what))) | |
395 | mod = scm_module_public_interface (mod); | |
396 | if (SCM_FALSEP (mod)) | |
397 | { | |
da8b4747 | 398 | finish_args = scm_list_1 (what); |
fd358575 AW |
399 | goto vm_error_no_such_module; |
400 | } | |
401 | /* might longjmp */ | |
402 | what = scm_module_lookup (mod, SCM_CADR (what)); | |
3aabb7b7 AW |
403 | } |
404 | ||
fd358575 | 405 | OBJECT_SET (objnum, what); |
9cc649b8 AW |
406 | } |
407 | ||
fd358575 | 408 | VARIABLE_SET (what, *sp); |
9cc649b8 AW |
409 | DROP (); |
410 | NEXT; | |
411 | } | |
412 | ||
53e28ed9 | 413 | VM_DEFINE_INSTRUCTION (30, externals, "externals", 0, 0, 1) |
3de80ed5 AW |
414 | { |
415 | PUSH (external); | |
416 | NEXT; | |
417 | } | |
418 | ||
a98cef7e KN |
419 | \f |
420 | /* | |
421 | * branch and jump | |
422 | */ | |
423 | ||
efbd5892 AW |
424 | /* offset must be a signed short!!! */ |
425 | #define FETCH_OFFSET(offset) \ | |
17e90c5e | 426 | { \ |
41f248a8 KN |
427 | int h = FETCH (); \ |
428 | int l = FETCH (); \ | |
efbd5892 AW |
429 | offset = (h << 8) + l; \ |
430 | } | |
431 | ||
432 | #define BR(p) \ | |
433 | { \ | |
434 | signed short offset; \ | |
435 | FETCH_OFFSET (offset); \ | |
17e90c5e KN |
436 | if (p) \ |
437 | ip += offset; \ | |
11ea1aba | 438 | NULLSTACK (1); \ |
17e90c5e KN |
439 | DROP (); \ |
440 | NEXT; \ | |
441 | } | |
442 | ||
53e28ed9 | 443 | VM_DEFINE_INSTRUCTION (31, br, "br", 2, 0, 0) |
41f248a8 KN |
444 | { |
445 | int h = FETCH (); | |
446 | int l = FETCH (); | |
447 | ip += (signed short) (h << 8) + l; | |
448 | NEXT; | |
449 | } | |
450 | ||
53e28ed9 | 451 | VM_DEFINE_INSTRUCTION (32, br_if, "br-if", 2, 0, 0) |
a98cef7e | 452 | { |
17e90c5e | 453 | BR (!SCM_FALSEP (*sp)); |
a98cef7e KN |
454 | } |
455 | ||
53e28ed9 | 456 | VM_DEFINE_INSTRUCTION (33, br_if_not, "br-if-not", 2, 0, 0) |
a98cef7e | 457 | { |
17e90c5e | 458 | BR (SCM_FALSEP (*sp)); |
a98cef7e KN |
459 | } |
460 | ||
53e28ed9 | 461 | VM_DEFINE_INSTRUCTION (34, br_if_eq, "br-if-eq", 2, 0, 0) |
a98cef7e | 462 | { |
2c0f99a2 AW |
463 | sp--; /* underflow? */ |
464 | BR (SCM_EQ_P (sp[0], sp[1])); | |
a98cef7e KN |
465 | } |
466 | ||
53e28ed9 | 467 | VM_DEFINE_INSTRUCTION (35, br_if_not_eq, "br-if-not-eq", 2, 0, 0) |
a98cef7e | 468 | { |
2c0f99a2 AW |
469 | sp--; /* underflow? */ |
470 | BR (!SCM_EQ_P (sp[0], sp[1])); | |
17e90c5e KN |
471 | } |
472 | ||
53e28ed9 | 473 | VM_DEFINE_INSTRUCTION (36, br_if_null, "br-if-null", 2, 0, 0) |
17e90c5e KN |
474 | { |
475 | BR (SCM_NULLP (*sp)); | |
476 | } | |
477 | ||
53e28ed9 | 478 | VM_DEFINE_INSTRUCTION (37, br_if_not_null, "br-if-not-null", 2, 0, 0) |
17e90c5e KN |
479 | { |
480 | BR (!SCM_NULLP (*sp)); | |
a98cef7e KN |
481 | } |
482 | ||
a98cef7e KN |
483 | \f |
484 | /* | |
485 | * Subprogram call | |
486 | */ | |
487 | ||
53e28ed9 | 488 | VM_DEFINE_INSTRUCTION (38, make_closure, "make-closure", 0, 1, 1) |
a98cef7e | 489 | { |
3d5ee0cd | 490 | SYNC_BEFORE_GC (); |
7edf2001 AW |
491 | SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp), |
492 | SCM_PROGRAM_OBJTABLE (*sp), external); | |
17e90c5e | 493 | NEXT; |
a98cef7e KN |
494 | } |
495 | ||
53e28ed9 | 496 | VM_DEFINE_INSTRUCTION (39, call, "call", 1, -1, 1) |
a98cef7e | 497 | { |
3616e9e9 | 498 | SCM x; |
17e90c5e | 499 | nargs = FETCH (); |
a98cef7e KN |
500 | |
501 | vm_call: | |
c8b9df71 KN |
502 | x = sp[-nargs]; |
503 | ||
e311f5fa AW |
504 | SYNC_REGISTER (); |
505 | SCM_TICK; /* allow interrupt here */ | |
506 | ||
a98cef7e KN |
507 | /* |
508 | * Subprogram call | |
509 | */ | |
3616e9e9 | 510 | if (SCM_PROGRAM_P (x)) |
a98cef7e | 511 | { |
3616e9e9 | 512 | program = x; |
499a4c07 | 513 | CACHE_PROGRAM (); |
17e90c5e KN |
514 | INIT_ARGS (); |
515 | NEW_FRAME (); | |
17e90c5e KN |
516 | ENTER_HOOK (); |
517 | APPLY_HOOK (); | |
a98cef7e KN |
518 | NEXT; |
519 | } | |
d507b25f AW |
520 | #ifdef ENABLE_TRAMPOLINE |
521 | /* Seems to slow down the fibo test, dunno why */ | |
a98cef7e | 522 | /* |
659b4611 AW |
523 | * Subr call |
524 | */ | |
525 | switch (nargs) | |
526 | { | |
527 | case 0: | |
528 | { | |
529 | scm_t_trampoline_0 call = scm_trampoline_0 (x); | |
530 | if (call) | |
531 | { | |
532 | SYNC_ALL (); | |
533 | *sp = call (x); | |
534 | NEXT; | |
535 | } | |
536 | break; | |
537 | } | |
538 | case 1: | |
539 | { | |
540 | scm_t_trampoline_1 call = scm_trampoline_1 (x); | |
541 | if (call) | |
542 | { | |
543 | SCM arg1; | |
544 | POP (arg1); | |
545 | SYNC_ALL (); | |
546 | *sp = call (x, arg1); | |
547 | NEXT; | |
548 | } | |
549 | break; | |
550 | } | |
551 | case 2: | |
552 | { | |
553 | scm_t_trampoline_2 call = scm_trampoline_2 (x); | |
554 | if (call) | |
555 | { | |
556 | SCM arg1, arg2; | |
557 | POP (arg2); | |
558 | POP (arg1); | |
559 | SYNC_ALL (); | |
560 | *sp = call (x, arg1, arg2); | |
561 | NEXT; | |
562 | } | |
563 | break; | |
564 | } | |
565 | } | |
d507b25f | 566 | #endif |
659b4611 AW |
567 | /* |
568 | * Other interpreted or compiled call | |
a98cef7e | 569 | */ |
3616e9e9 | 570 | if (!SCM_FALSEP (scm_procedure_p (x))) |
a98cef7e | 571 | { |
f41cb00c LC |
572 | /* At this point, the stack contains the procedure and each one of its |
573 | arguments. */ | |
17e90c5e | 574 | POP_LIST (nargs); |
1865ad56 | 575 | SYNC_REGISTER (); |
887ce75a AW |
576 | /* keep args on stack so they are marked */ |
577 | sp[-1] = scm_apply (x, sp[0], SCM_EOL); | |
66db076a | 578 | NULLSTACK_FOR_NONLOCAL_EXIT (); |
887ce75a | 579 | DROP (); |
42906d74 AW |
580 | if (SCM_UNLIKELY (SCM_VALUESP (*sp))) |
581 | { | |
582 | /* truncate values */ | |
583 | SCM values; | |
584 | POP (values); | |
585 | values = scm_struct_ref (values, SCM_INUM0); | |
586 | if (scm_is_null (values)) | |
587 | goto vm_error_not_enough_values; | |
588 | PUSH (SCM_CAR (values)); | |
589 | } | |
17e90c5e | 590 | NEXT; |
a98cef7e KN |
591 | } |
592 | /* | |
593 | * Continuation call | |
594 | */ | |
3616e9e9 | 595 | if (SCM_VM_CONT_P (x)) |
a98cef7e | 596 | { |
fcd4901b | 597 | program = x; |
f03c31db | 598 | vm_call_continuation: |
a98cef7e | 599 | /* Check the number of arguments */ |
f03c31db | 600 | /* FIXME multiple args */ |
382693fe | 601 | if (nargs != 1) |
fcd4901b | 602 | scm_wrong_num_args (program); |
a98cef7e KN |
603 | |
604 | /* Reinstate the continuation */ | |
17e90c5e | 605 | EXIT_HOOK (); |
fcd4901b | 606 | reinstate_vm_cont (vp, program); |
3d5ee0cd | 607 | CACHE_REGISTER (); |
af988bbf | 608 | program = SCM_FRAME_PROGRAM (fp); |
3616e9e9 | 609 | CACHE_PROGRAM (); |
a98cef7e KN |
610 | NEXT; |
611 | } | |
612 | ||
66292535 | 613 | program = x; |
17e90c5e | 614 | goto vm_error_wrong_type_apply; |
a98cef7e KN |
615 | } |
616 | ||
53e28ed9 | 617 | VM_DEFINE_INSTRUCTION (40, goto_args, "goto/args", 1, -1, 1) |
a98cef7e | 618 | { |
f41cb00c | 619 | register SCM x; |
17e90c5e | 620 | nargs = FETCH (); |
f03c31db | 621 | vm_goto_args: |
3616e9e9 | 622 | x = sp[-nargs]; |
17e90c5e | 623 | |
28a2f57b | 624 | SYNC_REGISTER (); |
17e90c5e | 625 | SCM_TICK; /* allow interrupt here */ |
a98cef7e KN |
626 | |
627 | /* | |
17e90c5e | 628 | * Tail recursive call |
a98cef7e | 629 | */ |
17e90c5e | 630 | if (SCM_EQ_P (x, program)) |
a98cef7e | 631 | { |
f21dfea6 | 632 | int i; |
17e90c5e KN |
633 | |
634 | /* Move arguments */ | |
f21dfea6 KN |
635 | INIT_ARGS (); |
636 | sp -= bp->nargs - 1; | |
637 | for (i = 0; i < bp->nargs; i++) | |
638 | LOCAL_SET (i, sp[i]); | |
f41cb00c LC |
639 | |
640 | /* Drop the first argument and the program itself. */ | |
641 | sp -= 2; | |
5e390de6 AW |
642 | NULLSTACK (bp->nargs + 1); |
643 | ||
644 | /* Freshen the externals */ | |
53e28ed9 | 645 | external = SCM_PROGRAM_EXTERNALS (x); |
5e390de6 AW |
646 | for (i = 0; i < bp->nexts; i++) |
647 | CONS (external, SCM_UNDEFINED, external); | |
648 | SCM_FRAME_DATA_ADDRESS (fp)[0] = external; | |
a98cef7e | 649 | |
81d677eb AW |
650 | /* Init locals to valid SCM values */ |
651 | for (i = 0; i < bp->nlocs; i++) | |
652 | LOCAL_SET (i + bp->nargs, SCM_UNDEFINED); | |
653 | ||
f21dfea6 | 654 | /* Call itself */ |
17e90c5e | 655 | ip = bp->base; |
17e90c5e | 656 | APPLY_HOOK (); |
a98cef7e KN |
657 | NEXT; |
658 | } | |
28106f54 | 659 | |
17e90c5e | 660 | /* |
28106f54 | 661 | * Tail call, but not to self -- reuse the frame, keeping the ra and dl |
17e90c5e | 662 | */ |
3616e9e9 | 663 | if (SCM_PROGRAM_P (x)) |
17e90c5e | 664 | { |
28106f54 AW |
665 | SCM *data, *tail_args, *dl; |
666 | int i; | |
da320011 | 667 | scm_byte_t *ra, *mvra; |
11ea1aba AW |
668 | #ifdef VM_ENABLE_STACK_NULLING |
669 | SCM *old_sp; | |
670 | #endif | |
28106f54 | 671 | |
17e90c5e | 672 | EXIT_HOOK (); |
28106f54 AW |
673 | |
674 | /* save registers */ | |
675 | tail_args = stack_base + 2; | |
676 | ra = SCM_FRAME_RETURN_ADDRESS (fp); | |
da320011 | 677 | mvra = SCM_FRAME_MV_RETURN_ADDRESS (fp); |
28106f54 AW |
678 | dl = SCM_FRAME_DYNAMIC_LINK (fp); |
679 | ||
680 | /* switch programs */ | |
11ea1aba | 681 | program = x; |
28106f54 AW |
682 | CACHE_PROGRAM (); |
683 | INIT_ARGS (); | |
11ea1aba AW |
684 | /* delay updating the frame so that if INIT_ARGS has to cons up a rest |
685 | arg, going into GC, the stack still makes sense */ | |
686 | fp[-1] = program; | |
28106f54 AW |
687 | nargs = bp->nargs; |
688 | ||
11ea1aba AW |
689 | #ifdef VM_ENABLE_STACK_NULLING |
690 | old_sp = sp; | |
691 | CHECK_STACK_LEAK (); | |
692 | #endif | |
693 | ||
28106f54 AW |
694 | /* new registers -- logically this would be better later, but let's make |
695 | sure we have space for the locals now */ | |
696 | data = SCM_FRAME_DATA_ADDRESS (fp); | |
697 | ip = bp->base; | |
b1b942b7 | 698 | stack_base = data + 3; |
28106f54 AW |
699 | sp = stack_base; |
700 | CHECK_OVERFLOW (); | |
701 | ||
702 | /* copy args, bottom-up */ | |
703 | for (i = 0; i < nargs; i++) | |
704 | fp[i] = tail_args[i]; | |
705 | ||
11ea1aba AW |
706 | NULLSTACK (old_sp - sp); |
707 | ||
28106f54 AW |
708 | /* init locals */ |
709 | for (i = bp->nlocs; i; i--) | |
710 | data[-i] = SCM_UNDEFINED; | |
711 | ||
28106f54 | 712 | /* Set frame data */ |
b1b942b7 AW |
713 | data[3] = (SCM)ra; |
714 | data[2] = (SCM)mvra; | |
715 | data[1] = (SCM)dl; | |
11ea1aba AW |
716 | |
717 | /* Postpone initializing external vars, because if the CONS causes a GC, | |
718 | we want the stack marker to see the data array formatted as expected. */ | |
719 | data[0] = SCM_UNDEFINED; | |
53e28ed9 | 720 | external = SCM_PROGRAM_EXTERNALS (fp[-1]); |
11ea1aba AW |
721 | for (i = 0; i < bp->nexts; i++) |
722 | CONS (external, SCM_UNDEFINED, external); | |
28106f54 | 723 | data[0] = external; |
11ea1aba | 724 | |
28106f54 AW |
725 | ENTER_HOOK (); |
726 | APPLY_HOOK (); | |
727 | NEXT; | |
17e90c5e | 728 | } |
d507b25f AW |
729 | #ifdef ENABLE_TRAMPOLINE |
730 | /* This seems to actually slow down the fibo test -- dunno why */ | |
a98cef7e | 731 | /* |
659b4611 AW |
732 | * Subr call |
733 | */ | |
734 | switch (nargs) | |
735 | { | |
736 | case 0: | |
737 | { | |
738 | scm_t_trampoline_0 call = scm_trampoline_0 (x); | |
739 | if (call) | |
740 | { | |
741 | SYNC_ALL (); | |
742 | *sp = call (x); | |
743 | goto vm_return; | |
744 | } | |
745 | break; | |
746 | } | |
747 | case 1: | |
748 | { | |
749 | scm_t_trampoline_1 call = scm_trampoline_1 (x); | |
750 | if (call) | |
751 | { | |
752 | SCM arg1; | |
753 | POP (arg1); | |
754 | SYNC_ALL (); | |
755 | *sp = call (x, arg1); | |
756 | goto vm_return; | |
757 | } | |
758 | break; | |
759 | } | |
760 | case 2: | |
761 | { | |
762 | scm_t_trampoline_2 call = scm_trampoline_2 (x); | |
763 | if (call) | |
764 | { | |
765 | SCM arg1, arg2; | |
766 | POP (arg2); | |
767 | POP (arg1); | |
768 | SYNC_ALL (); | |
769 | *sp = call (x, arg1, arg2); | |
770 | goto vm_return; | |
771 | } | |
772 | break; | |
773 | } | |
774 | } | |
d507b25f | 775 | #endif |
659b4611 AW |
776 | |
777 | /* | |
778 | * Other interpreted or compiled call | |
a98cef7e | 779 | */ |
3616e9e9 | 780 | if (!SCM_FALSEP (scm_procedure_p (x))) |
a98cef7e | 781 | { |
17e90c5e | 782 | POP_LIST (nargs); |
1865ad56 | 783 | SYNC_REGISTER (); |
887ce75a | 784 | sp[-1] = scm_apply (x, sp[0], SCM_EOL); |
66db076a | 785 | NULLSTACK_FOR_NONLOCAL_EXIT (); |
887ce75a | 786 | DROP (); |
42906d74 AW |
787 | if (SCM_UNLIKELY (SCM_VALUESP (*sp))) |
788 | { | |
789 | /* multiple values returned to continuation */ | |
790 | SCM values; | |
791 | POP (values); | |
792 | values = scm_struct_ref (values, SCM_INUM0); | |
793 | nvalues = scm_ilength (values); | |
fb10a008 | 794 | PUSH_LIST (values, SCM_NULLP); |
42906d74 AW |
795 | goto vm_return_values; |
796 | } | |
a98cef7e KN |
797 | goto vm_return; |
798 | } | |
fcd4901b AW |
799 | |
800 | program = x; | |
801 | ||
a98cef7e KN |
802 | /* |
803 | * Continuation call | |
804 | */ | |
fcd4901b | 805 | if (SCM_VM_CONT_P (program)) |
f03c31db | 806 | goto vm_call_continuation; |
a98cef7e | 807 | |
17e90c5e KN |
808 | goto vm_error_wrong_type_apply; |
809 | } | |
810 | ||
53e28ed9 | 811 | VM_DEFINE_INSTRUCTION (41, goto_nargs, "goto/nargs", 0, 0, 1) |
efbd5892 AW |
812 | { |
813 | SCM x; | |
814 | POP (x); | |
815 | nargs = scm_to_int (x); | |
d51406fe | 816 | /* FIXME: should truncate values? */ |
efbd5892 AW |
817 | goto vm_goto_args; |
818 | } | |
819 | ||
53e28ed9 | 820 | VM_DEFINE_INSTRUCTION (42, call_nargs, "call/nargs", 0, 0, 1) |
efbd5892 AW |
821 | { |
822 | SCM x; | |
823 | POP (x); | |
824 | nargs = scm_to_int (x); | |
d51406fe | 825 | /* FIXME: should truncate values? */ |
efbd5892 AW |
826 | goto vm_call; |
827 | } | |
828 | ||
53e28ed9 | 829 | VM_DEFINE_INSTRUCTION (43, mv_call, "mv-call", 3, -1, 1) |
a222b0fa AW |
830 | { |
831 | SCM x; | |
efbd5892 | 832 | signed short offset; |
a222b0fa AW |
833 | |
834 | nargs = FETCH (); | |
efbd5892 | 835 | FETCH_OFFSET (offset); |
a222b0fa AW |
836 | |
837 | x = sp[-nargs]; | |
838 | ||
839 | /* | |
840 | * Subprogram call | |
841 | */ | |
842 | if (SCM_PROGRAM_P (x)) | |
843 | { | |
844 | program = x; | |
845 | CACHE_PROGRAM (); | |
846 | INIT_ARGS (); | |
847 | NEW_FRAME (); | |
b1b942b7 | 848 | SCM_FRAME_DATA_ADDRESS (fp)[2] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset); |
a222b0fa AW |
849 | ENTER_HOOK (); |
850 | APPLY_HOOK (); | |
851 | NEXT; | |
852 | } | |
853 | /* | |
854 | * Other interpreted or compiled call | |
855 | */ | |
856 | if (!SCM_FALSEP (scm_procedure_p (x))) | |
857 | { | |
858 | /* At this point, the stack contains the procedure and each one of its | |
859 | arguments. */ | |
a222b0fa | 860 | POP_LIST (nargs); |
a222b0fa | 861 | SYNC_REGISTER (); |
887ce75a | 862 | sp[-1] = scm_apply (x, sp[0], SCM_EOL); |
66db076a | 863 | NULLSTACK_FOR_NONLOCAL_EXIT (); |
887ce75a | 864 | DROP (); |
a222b0fa AW |
865 | if (SCM_VALUESP (*sp)) |
866 | { | |
867 | SCM values, len; | |
868 | POP (values); | |
869 | values = scm_struct_ref (values, SCM_INUM0); | |
870 | len = scm_length (values); | |
fb10a008 | 871 | PUSH_LIST (values, SCM_NULLP); |
a222b0fa AW |
872 | PUSH (len); |
873 | ip += offset; | |
874 | } | |
875 | NEXT; | |
876 | } | |
877 | /* | |
878 | * Continuation call | |
879 | */ | |
880 | if (SCM_VM_CONT_P (x)) | |
881 | { | |
882 | program = x; | |
883 | goto vm_call_continuation; | |
884 | } | |
885 | ||
886 | program = x; | |
887 | goto vm_error_wrong_type_apply; | |
888 | } | |
889 | ||
53e28ed9 | 890 | VM_DEFINE_INSTRUCTION (44, apply, "apply", 1, -1, 1) |
3616e9e9 | 891 | { |
c8b9df71 KN |
892 | int len; |
893 | SCM ls; | |
894 | POP (ls); | |
895 | ||
896 | nargs = FETCH (); | |
9a8cc8e7 | 897 | ASSERT (nargs >= 2); |
c8b9df71 KN |
898 | |
899 | len = scm_ilength (ls); | |
900 | if (len < 0) | |
901 | goto vm_error_wrong_type_arg; | |
902 | ||
fb10a008 | 903 | PUSH_LIST (ls, SCM_NULL_OR_NIL_P); |
c8b9df71 KN |
904 | |
905 | nargs += len - 2; | |
906 | goto vm_call; | |
3616e9e9 KN |
907 | } |
908 | ||
53e28ed9 | 909 | VM_DEFINE_INSTRUCTION (45, goto_apply, "goto/apply", 1, -1, 1) |
f03c31db AW |
910 | { |
911 | int len; | |
912 | SCM ls; | |
913 | POP (ls); | |
914 | ||
915 | nargs = FETCH (); | |
9a8cc8e7 | 916 | ASSERT (nargs >= 2); |
f03c31db AW |
917 | |
918 | len = scm_ilength (ls); | |
919 | if (len < 0) | |
920 | goto vm_error_wrong_type_arg; | |
921 | ||
fb10a008 | 922 | PUSH_LIST (ls, SCM_NULL_OR_NIL_P); |
f03c31db AW |
923 | |
924 | nargs += len - 2; | |
925 | goto vm_goto_args; | |
926 | } | |
927 | ||
53e28ed9 | 928 | VM_DEFINE_INSTRUCTION (46, call_cc, "call/cc", 0, 1, 1) |
17e90c5e | 929 | { |
76282387 AW |
930 | int first; |
931 | SCM proc, cont; | |
932 | POP (proc); | |
933 | SYNC_ALL (); | |
934 | cont = scm_make_continuation (&first); | |
935 | if (first) | |
936 | { | |
937 | PUSH (proc); | |
938 | PUSH (cont); | |
939 | nargs = 1; | |
940 | goto vm_call; | |
941 | } | |
11ea1aba AW |
942 | ASSERT (sp == vp->sp); |
943 | ASSERT (fp == vp->fp); | |
76282387 AW |
944 | else if (SCM_VALUESP (cont)) |
945 | { | |
946 | /* multiple values returned to continuation */ | |
947 | SCM values; | |
948 | values = scm_struct_ref (cont, SCM_INUM0); | |
949 | if (SCM_NULLP (values)) | |
9a8cc8e7 | 950 | goto vm_error_no_values; |
76282387 AW |
951 | /* non-tail context does not accept multiple values? */ |
952 | PUSH (SCM_CAR (values)); | |
953 | NEXT; | |
954 | } | |
955 | else | |
956 | { | |
957 | PUSH (cont); | |
958 | NEXT; | |
959 | } | |
a98cef7e KN |
960 | } |
961 | ||
53e28ed9 | 962 | VM_DEFINE_INSTRUCTION (47, goto_cc, "goto/cc", 0, 1, 1) |
f03c31db | 963 | { |
76282387 AW |
964 | int first; |
965 | SCM proc, cont; | |
966 | POP (proc); | |
967 | SYNC_ALL (); | |
968 | cont = scm_make_continuation (&first); | |
66db076a AW |
969 | ASSERT (sp == vp->sp); |
970 | ASSERT (fp == vp->fp); | |
76282387 AW |
971 | if (first) |
972 | { | |
973 | PUSH (proc); | |
974 | PUSH (cont); | |
975 | nargs = 1; | |
976 | goto vm_goto_args; | |
977 | } | |
978 | else if (SCM_VALUESP (cont)) | |
979 | { | |
980 | /* multiple values returned to continuation */ | |
981 | SCM values; | |
982 | values = scm_struct_ref (cont, SCM_INUM0); | |
983 | nvalues = scm_ilength (values); | |
fb10a008 | 984 | PUSH_LIST (values, SCM_NULLP); |
76282387 AW |
985 | goto vm_return_values; |
986 | } | |
987 | else | |
988 | { | |
989 | PUSH (cont); | |
990 | goto vm_return; | |
991 | } | |
f03c31db AW |
992 | } |
993 | ||
131f7d6c | 994 | VM_DEFINE_INSTRUCTION (48, return, "return", 0, 1, 1) |
a98cef7e | 995 | { |
a98cef7e | 996 | vm_return: |
17e90c5e KN |
997 | EXIT_HOOK (); |
998 | RETURN_HOOK (); | |
ef7e1868 AW |
999 | SYNC_REGISTER (); |
1000 | SCM_TICK; /* allow interrupt here */ | |
f13c269b AW |
1001 | { |
1002 | SCM ret, *data; | |
1003 | data = SCM_FRAME_DATA_ADDRESS (fp); | |
1004 | ||
1005 | POP (ret); | |
11ea1aba | 1006 | ASSERT (sp == stack_base); |
b1b942b7 | 1007 | ASSERT (stack_base == data + 3); |
f13c269b AW |
1008 | |
1009 | /* Restore registers */ | |
1010 | sp = SCM_FRAME_LOWER_ADDRESS (fp); | |
b1b942b7 AW |
1011 | ip = SCM_FRAME_BYTE_CAST (data[3]); |
1012 | fp = SCM_FRAME_STACK_CAST (data[1]); | |
11ea1aba AW |
1013 | { |
1014 | #ifdef VM_ENABLE_STACK_NULLING | |
1015 | int nullcount = stack_base - sp; | |
1016 | #endif | |
1017 | stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1; | |
1018 | NULLSTACK (nullcount); | |
1019 | } | |
f13c269b AW |
1020 | |
1021 | /* Set return value (sp is already pushed) */ | |
1022 | *sp = ret; | |
1023 | } | |
17e90c5e | 1024 | |
15df3447 | 1025 | /* Restore the last program */ |
af988bbf | 1026 | program = SCM_FRAME_PROGRAM (fp); |
499a4c07 | 1027 | CACHE_PROGRAM (); |
af988bbf | 1028 | CACHE_EXTERNAL (); |
7e4760e4 | 1029 | CHECK_IP (); |
a98cef7e KN |
1030 | NEXT; |
1031 | } | |
17e90c5e | 1032 | |
53e28ed9 | 1033 | VM_DEFINE_INSTRUCTION (49, return_values, "return/values", 1, -1, -1) |
a222b0fa | 1034 | { |
ef24c01b AW |
1035 | /* nvalues declared at top level, because for some reason gcc seems to think |
1036 | that perhaps it might be used without declaration. Fooey to that, I say. */ | |
1037 | SCM *data; | |
1038 | ||
1039 | nvalues = FETCH (); | |
1040 | vm_return_values: | |
a222b0fa AW |
1041 | EXIT_HOOK (); |
1042 | RETURN_HOOK (); | |
ef24c01b AW |
1043 | |
1044 | data = SCM_FRAME_DATA_ADDRESS (fp); | |
b1b942b7 | 1045 | ASSERT (stack_base == data + 3); |
a222b0fa | 1046 | |
b1b942b7 AW |
1047 | /* data[2] is the mv return address */ |
1048 | if (nvalues != 1 && data[2]) | |
ef24c01b AW |
1049 | { |
1050 | int i; | |
1051 | /* Restore registers */ | |
1052 | sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; | |
b1b942b7 AW |
1053 | ip = SCM_FRAME_BYTE_CAST (data[2]); /* multiple value ra */ |
1054 | fp = SCM_FRAME_STACK_CAST (data[1]); | |
a222b0fa | 1055 | |
ef24c01b AW |
1056 | /* Push return values, and the number of values */ |
1057 | for (i = 0; i < nvalues; i++) | |
1058 | *++sp = stack_base[1+i]; | |
1059 | *++sp = SCM_I_MAKINUM (nvalues); | |
a222b0fa | 1060 | |
ef24c01b | 1061 | /* Finally set new stack_base */ |
11ea1aba | 1062 | NULLSTACK (stack_base - sp + nvalues + 1); |
ef24c01b AW |
1063 | stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1; |
1064 | } | |
1065 | else if (nvalues >= 1) | |
1066 | { | |
1067 | /* Multiple values for a single-valued continuation -- here's where I | |
1068 | break with guile tradition and try and do something sensible. (Also, | |
1069 | this block handles the single-valued return to an mv | |
1070 | continuation.) */ | |
1071 | /* Restore registers */ | |
1072 | sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; | |
b1b942b7 AW |
1073 | ip = SCM_FRAME_BYTE_CAST (data[3]); /* single value ra */ |
1074 | fp = SCM_FRAME_STACK_CAST (data[1]); | |
a222b0fa | 1075 | |
ef24c01b AW |
1076 | /* Push first value */ |
1077 | *++sp = stack_base[1]; | |
a222b0fa | 1078 | |
ef24c01b | 1079 | /* Finally set new stack_base */ |
9b10d0bc | 1080 | NULLSTACK (stack_base - sp + nvalues + 1); |
ef24c01b AW |
1081 | stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1; |
1082 | } | |
1083 | else | |
1084 | goto vm_error_no_values; | |
a222b0fa AW |
1085 | |
1086 | /* Restore the last program */ | |
1087 | program = SCM_FRAME_PROGRAM (fp); | |
1088 | CACHE_PROGRAM (); | |
1089 | CACHE_EXTERNAL (); | |
1090 | CHECK_IP (); | |
1091 | NEXT; | |
1092 | } | |
1093 | ||
53e28ed9 | 1094 | VM_DEFINE_INSTRUCTION (50, return_values_star, "return/values*", 1, -1, -1) |
ef24c01b AW |
1095 | { |
1096 | SCM l; | |
1097 | ||
1098 | nvalues = FETCH (); | |
11ea1aba | 1099 | ASSERT (nvalues >= 1); |
ef24c01b AW |
1100 | |
1101 | nvalues--; | |
1102 | POP (l); | |
1103 | while (SCM_CONSP (l)) | |
1104 | { | |
1105 | PUSH (SCM_CAR (l)); | |
1106 | l = SCM_CDR (l); | |
1107 | nvalues++; | |
1108 | } | |
fb10a008 | 1109 | if (SCM_UNLIKELY (!SCM_NULL_OR_NIL_P (l))) { |
e06e857c | 1110 | finish_args = scm_list_1 (l); |
fb10a008 AW |
1111 | goto vm_error_improper_list; |
1112 | } | |
ef24c01b AW |
1113 | |
1114 | goto vm_return_values; | |
1115 | } | |
1116 | ||
53e28ed9 | 1117 | VM_DEFINE_INSTRUCTION (51, truncate_values, "truncate-values", 2, -1, -1) |
d51406fe AW |
1118 | { |
1119 | SCM x; | |
1120 | int nbinds, rest; | |
1121 | POP (x); | |
1122 | nvalues = scm_to_int (x); | |
1123 | nbinds = FETCH (); | |
1124 | rest = FETCH (); | |
1125 | ||
1126 | if (rest) | |
1127 | nbinds--; | |
1128 | ||
1129 | if (nvalues < nbinds) | |
1130 | goto vm_error_not_enough_values; | |
1131 | ||
1132 | if (rest) | |
1133 | POP_LIST (nvalues - nbinds); | |
1134 | else | |
1135 | DROPN (nvalues - nbinds); | |
1136 | ||
1137 | NEXT; | |
1138 | } | |
1139 | ||
53e28ed9 AW |
1140 | /* |
1141 | (defun renumber-ops () | |
1142 | "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" | |
1143 | (interactive "") | |
1144 | (save-excursion | |
1145 | (let ((counter -1)) (goto-char (point-min)) | |
1146 | (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t) | |
1147 | (replace-match | |
1148 | (number-to-string (setq counter (1+ counter))) | |
1149 | t t nil 1))))) | |
1150 | */ | |
17e90c5e KN |
1151 | /* |
1152 | Local Variables: | |
1153 | c-file-style: "gnu" | |
1154 | End: | |
1155 | */ |