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