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 (); |
a6df585a | 60 | POP (ret); |
17e90c5e KN |
61 | FREE_FRAME (); |
62 | SYNC_ALL (); | |
63 | return ret; | |
a98cef7e KN |
64 | } |
65 | ||
7a0d0cee KN |
66 | VM_DEFINE_INSTRUCTION (break, "break", 0, 0, 0) |
67 | { | |
68 | BREAK_HOOK (); | |
69 | NEXT; | |
70 | } | |
71 | ||
499a4c07 | 72 | VM_DEFINE_INSTRUCTION (drop, "drop", 0, 0, 0) |
a98cef7e | 73 | { |
17e90c5e | 74 | DROP (); |
a98cef7e KN |
75 | NEXT; |
76 | } | |
77 | ||
cb4cca12 KN |
78 | VM_DEFINE_INSTRUCTION (mark, "mark", 0, 0, 1) |
79 | { | |
80 | PUSH (SCM_UNDEFINED); | |
81 | NEXT; | |
82 | } | |
83 | ||
46cd9a34 | 84 | VM_DEFINE_INSTRUCTION (dup, "dup", 0, 0, 1) |
26403690 | 85 | { |
f349065e KN |
86 | SCM x = *sp; |
87 | PUSH (x); | |
26403690 KN |
88 | NEXT; |
89 | } | |
90 | ||
17e90c5e KN |
91 | \f |
92 | /* | |
93 | * Object creation | |
94 | */ | |
a98cef7e | 95 | |
46cd9a34 | 96 | VM_DEFINE_INSTRUCTION (void, "void", 0, 0, 1) |
a98cef7e | 97 | { |
17e90c5e | 98 | PUSH (SCM_UNSPECIFIED); |
a98cef7e KN |
99 | NEXT; |
100 | } | |
101 | ||
46cd9a34 | 102 | VM_DEFINE_INSTRUCTION (make_true, "make-true", 0, 0, 1) |
a98cef7e | 103 | { |
17e90c5e | 104 | PUSH (SCM_BOOL_T); |
a98cef7e KN |
105 | NEXT; |
106 | } | |
107 | ||
46cd9a34 | 108 | VM_DEFINE_INSTRUCTION (make_false, "make-false", 0, 0, 1) |
a98cef7e | 109 | { |
17e90c5e | 110 | PUSH (SCM_BOOL_F); |
a98cef7e KN |
111 | NEXT; |
112 | } | |
113 | ||
46cd9a34 | 114 | VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0, 0, 1) |
a98cef7e | 115 | { |
17e90c5e | 116 | PUSH (SCM_EOL); |
a98cef7e KN |
117 | NEXT; |
118 | } | |
119 | ||
46cd9a34 | 120 | VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1) |
a98cef7e | 121 | { |
2d80426a | 122 | PUSH (SCM_I_MAKINUM ((signed char) FETCH ())); |
a98cef7e KN |
123 | NEXT; |
124 | } | |
125 | ||
46cd9a34 | 126 | VM_DEFINE_INSTRUCTION (make_int8_0, "make-int8:0", 0, 0, 1) |
a98cef7e | 127 | { |
238e7a11 | 128 | PUSH (SCM_INUM0); |
a98cef7e KN |
129 | NEXT; |
130 | } | |
131 | ||
46cd9a34 | 132 | VM_DEFINE_INSTRUCTION (make_int8_1, "make-int8:1", 0, 0, 1) |
a98cef7e | 133 | { |
238e7a11 | 134 | PUSH (SCM_I_MAKINUM (1)); |
a98cef7e KN |
135 | NEXT; |
136 | } | |
137 | ||
46cd9a34 | 138 | VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2, 0, 1) |
a98cef7e | 139 | { |
ea9b4b29 KN |
140 | int h = FETCH (); |
141 | int l = FETCH (); | |
2d80426a | 142 | PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l)); |
a98cef7e KN |
143 | NEXT; |
144 | } | |
145 | ||
46cd9a34 | 146 | VM_DEFINE_INSTRUCTION (make_char8, "make-char8", 1, 0, 1) |
a98cef7e | 147 | { |
17e90c5e | 148 | PUSH (SCM_MAKE_CHAR (FETCH ())); |
a98cef7e KN |
149 | NEXT; |
150 | } | |
151 | ||
23b587b0 | 152 | VM_DEFINE_INSTRUCTION (list, "list", 2, -1, 1) |
cb4cca12 | 153 | { |
23b587b0 LC |
154 | unsigned h = FETCH (); |
155 | unsigned l = FETCH (); | |
156 | unsigned len = ((h << 8) + l); | |
157 | POP_LIST (len); | |
cb4cca12 KN |
158 | NEXT; |
159 | } | |
160 | ||
23b587b0 | 161 | VM_DEFINE_INSTRUCTION (vector, "vector", 2, -1, 1) |
cb4cca12 | 162 | { |
23b587b0 LC |
163 | unsigned h = FETCH (); |
164 | unsigned l = FETCH (); | |
165 | unsigned len = ((h << 8) + l); | |
166 | POP_LIST (len); | |
cb4cca12 KN |
167 | *sp = scm_vector (*sp); |
168 | NEXT; | |
169 | } | |
170 | ||
171 | VM_DEFINE_INSTRUCTION (list_mark, "list-mark", 0, 0, 0) | |
172 | { | |
173 | POP_LIST_MARK (); | |
174 | NEXT; | |
175 | } | |
176 | ||
177 | VM_DEFINE_INSTRUCTION (vector_mark, "vector-mark", 0, 0, 0) | |
178 | { | |
179 | POP_LIST_MARK (); | |
180 | *sp = scm_vector (*sp); | |
181 | NEXT; | |
182 | } | |
183 | ||
184 | VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0) | |
185 | { | |
186 | SCM l; | |
187 | POP (l); | |
188 | for (; !SCM_NULLP (l); l = SCM_CDR (l)) | |
189 | PUSH (SCM_CAR (l)); | |
190 | NEXT; | |
191 | } | |
192 | ||
a98cef7e KN |
193 | \f |
194 | /* | |
17e90c5e | 195 | * Variable access |
a98cef7e KN |
196 | */ |
197 | ||
17e90c5e KN |
198 | #define OBJECT_REF(i) objects[i] |
199 | #define OBJECT_SET(i,o) objects[i] = o | |
a98cef7e | 200 | |
af988bbf KN |
201 | #define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i) |
202 | #define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o | |
a98cef7e | 203 | |
2d80426a LC |
204 | /* For the variable operations, we _must_ obviously avoid function calls to |
205 | `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do | |
206 | nothing more than the corresponding macros. */ | |
207 | #define VARIABLE_REF(v) SCM_VARIABLE_REF (v) | |
208 | #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) | |
209 | #define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED) | |
a98cef7e | 210 | |
17e90c5e | 211 | /* ref */ |
a98cef7e | 212 | |
46cd9a34 | 213 | VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1, 0, 1) |
a98cef7e | 214 | { |
a52b2d3d | 215 | register unsigned objnum = FETCH (); |
0b5f0e49 LC |
216 | CHECK_OBJECT (objnum); |
217 | PUSH (OBJECT_REF (objnum)); | |
17e90c5e | 218 | NEXT; |
a98cef7e KN |
219 | } |
220 | ||
46cd9a34 | 221 | VM_DEFINE_INSTRUCTION (local_ref, "local-ref", 1, 0, 1) |
a98cef7e | 222 | { |
17e90c5e KN |
223 | PUSH (LOCAL_REF (FETCH ())); |
224 | NEXT; | |
a98cef7e KN |
225 | } |
226 | ||
46cd9a34 | 227 | VM_DEFINE_INSTRUCTION (external_ref, "external-ref", 1, 0, 1) |
a98cef7e | 228 | { |
17e90c5e KN |
229 | unsigned int i; |
230 | SCM e = external; | |
231 | for (i = FETCH (); i; i--) | |
2a63758b KN |
232 | { |
233 | CHECK_EXTERNAL(e); | |
234 | e = SCM_CDR (e); | |
235 | } | |
236 | CHECK_EXTERNAL(e); | |
17e90c5e | 237 | PUSH (SCM_CAR (e)); |
a98cef7e KN |
238 | NEXT; |
239 | } | |
240 | ||
46cd9a34 | 241 | VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1) |
a98cef7e | 242 | { |
17e90c5e | 243 | SCM x = *sp; |
238e7a11 | 244 | |
2d80426a | 245 | if (!VARIABLE_BOUNDP (x)) |
17e90c5e | 246 | { |
238e7a11 LC |
247 | err_args = SCM_LIST1 (x); |
248 | /* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */ | |
17e90c5e KN |
249 | goto vm_error_unbound; |
250 | } | |
238e7a11 LC |
251 | else |
252 | { | |
2d80426a | 253 | SCM o = VARIABLE_REF (x); |
238e7a11 LC |
254 | *sp = o; |
255 | } | |
256 | ||
a98cef7e KN |
257 | NEXT; |
258 | } | |
259 | ||
9cc649b8 AW |
260 | VM_DEFINE_INSTRUCTION (late_variable_ref, "late-variable-ref", 1, 0, 1) |
261 | { | |
6297d229 AW |
262 | unsigned objnum = FETCH (); |
263 | SCM pair_or_var; | |
9cc649b8 | 264 | CHECK_OBJECT (objnum); |
6297d229 | 265 | pair_or_var = OBJECT_REF (objnum); |
9cc649b8 | 266 | |
6297d229 | 267 | if (!SCM_VARIABLEP (pair_or_var)) |
9cc649b8 | 268 | { |
6297d229 AW |
269 | SCM mod = scm_resolve_module (SCM_CAR (pair_or_var)); |
270 | /* module_lookup might longjmp */ | |
271 | pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var)); | |
272 | OBJECT_SET (objnum, pair_or_var); | |
273 | if (!VARIABLE_BOUNDP (pair_or_var)) | |
9cc649b8 | 274 | { |
6297d229 | 275 | err_args = SCM_LIST1 (pair_or_var); |
9cc649b8 AW |
276 | goto vm_error_unbound; |
277 | } | |
278 | } | |
279 | ||
6297d229 | 280 | PUSH (VARIABLE_REF (pair_or_var)); |
9cc649b8 AW |
281 | NEXT; |
282 | } | |
283 | ||
17e90c5e KN |
284 | /* set */ |
285 | ||
46cd9a34 | 286 | VM_DEFINE_INSTRUCTION (local_set, "local-set", 1, 1, 0) |
a98cef7e | 287 | { |
17e90c5e KN |
288 | LOCAL_SET (FETCH (), *sp); |
289 | DROP (); | |
a98cef7e KN |
290 | NEXT; |
291 | } | |
292 | ||
46cd9a34 | 293 | VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0) |
a98cef7e | 294 | { |
17e90c5e KN |
295 | unsigned int i; |
296 | SCM e = external; | |
297 | for (i = FETCH (); i; i--) | |
ac02b386 KN |
298 | { |
299 | CHECK_EXTERNAL(e); | |
300 | e = SCM_CDR (e); | |
301 | } | |
302 | CHECK_EXTERNAL(e); | |
17e90c5e KN |
303 | SCM_SETCAR (e, *sp); |
304 | DROP (); | |
a98cef7e KN |
305 | NEXT; |
306 | } | |
307 | ||
46cd9a34 | 308 | VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0) |
a98cef7e | 309 | { |
2d80426a | 310 | VARIABLE_SET (sp[0], sp[-1]); |
3616e9e9 KN |
311 | scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0])); |
312 | sp -= 2; | |
a98cef7e KN |
313 | NEXT; |
314 | } | |
315 | ||
9cc649b8 AW |
316 | VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0) |
317 | { | |
6297d229 AW |
318 | unsigned objnum = FETCH (); |
319 | SCM pair_or_var; | |
9cc649b8 | 320 | CHECK_OBJECT (objnum); |
6297d229 | 321 | pair_or_var = OBJECT_REF (objnum); |
9cc649b8 | 322 | |
6297d229 | 323 | if (!SCM_VARIABLEP (pair_or_var)) |
9cc649b8 | 324 | { |
6297d229 AW |
325 | SCM mod = scm_resolve_module (SCM_CAR (pair_or_var)); |
326 | /* module_lookup might longjmp */ | |
327 | pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var)); | |
328 | OBJECT_SET (objnum, pair_or_var); | |
9cc649b8 AW |
329 | } |
330 | ||
6297d229 | 331 | VARIABLE_SET (pair_or_var, *sp); |
9cc649b8 AW |
332 | DROP (); |
333 | NEXT; | |
334 | } | |
335 | ||
a98cef7e KN |
336 | \f |
337 | /* | |
338 | * branch and jump | |
339 | */ | |
340 | ||
17e90c5e KN |
341 | #define BR(p) \ |
342 | { \ | |
41f248a8 KN |
343 | int h = FETCH (); \ |
344 | int l = FETCH (); \ | |
345 | signed short offset = (h << 8) + l; \ | |
17e90c5e KN |
346 | if (p) \ |
347 | ip += offset; \ | |
348 | DROP (); \ | |
349 | NEXT; \ | |
350 | } | |
351 | ||
41f248a8 KN |
352 | VM_DEFINE_INSTRUCTION (br, "br", 2, 0, 0) |
353 | { | |
354 | int h = FETCH (); | |
355 | int l = FETCH (); | |
356 | ip += (signed short) (h << 8) + l; | |
357 | NEXT; | |
358 | } | |
359 | ||
360 | VM_DEFINE_INSTRUCTION (br_if, "br-if", 2, 0, 0) | |
a98cef7e | 361 | { |
17e90c5e | 362 | BR (!SCM_FALSEP (*sp)); |
a98cef7e KN |
363 | } |
364 | ||
41f248a8 | 365 | VM_DEFINE_INSTRUCTION (br_if_not, "br-if-not", 2, 0, 0) |
a98cef7e | 366 | { |
17e90c5e | 367 | BR (SCM_FALSEP (*sp)); |
a98cef7e KN |
368 | } |
369 | ||
41f248a8 | 370 | VM_DEFINE_INSTRUCTION (br_if_eq, "br-if-eq", 2, 0, 0) |
a98cef7e | 371 | { |
17e90c5e | 372 | BR (SCM_EQ_P (sp[0], sp--[1])); |
a98cef7e KN |
373 | } |
374 | ||
41f248a8 | 375 | VM_DEFINE_INSTRUCTION (br_if_not_eq, "br-if-not-eq", 2, 0, 0) |
a98cef7e | 376 | { |
17e90c5e KN |
377 | BR (!SCM_EQ_P (sp[0], sp--[1])); |
378 | } | |
379 | ||
41f248a8 | 380 | VM_DEFINE_INSTRUCTION (br_if_null, "br-if-null", 2, 0, 0) |
17e90c5e KN |
381 | { |
382 | BR (SCM_NULLP (*sp)); | |
383 | } | |
384 | ||
41f248a8 | 385 | VM_DEFINE_INSTRUCTION (br_if_not_null, "br-if-not-null", 2, 0, 0) |
17e90c5e KN |
386 | { |
387 | BR (!SCM_NULLP (*sp)); | |
a98cef7e KN |
388 | } |
389 | ||
a98cef7e KN |
390 | \f |
391 | /* | |
392 | * Subprogram call | |
393 | */ | |
394 | ||
46cd9a34 | 395 | VM_DEFINE_INSTRUCTION (make_closure, "make-closure", 0, 1, 1) |
a98cef7e | 396 | { |
3d5ee0cd KN |
397 | SYNC_BEFORE_GC (); |
398 | *sp = scm_c_make_closure (*sp, external); | |
17e90c5e | 399 | NEXT; |
a98cef7e KN |
400 | } |
401 | ||
46cd9a34 | 402 | VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1) |
a98cef7e | 403 | { |
3616e9e9 | 404 | SCM x; |
17e90c5e | 405 | nargs = FETCH (); |
a98cef7e KN |
406 | |
407 | vm_call: | |
c8b9df71 KN |
408 | x = sp[-nargs]; |
409 | ||
a98cef7e KN |
410 | /* |
411 | * Subprogram call | |
412 | */ | |
3616e9e9 | 413 | if (SCM_PROGRAM_P (x)) |
a98cef7e | 414 | { |
3616e9e9 | 415 | program = x; |
3d5ee0cd | 416 | vm_call_program: |
499a4c07 | 417 | CACHE_PROGRAM (); |
17e90c5e KN |
418 | INIT_ARGS (); |
419 | NEW_FRAME (); | |
17e90c5e KN |
420 | ENTER_HOOK (); |
421 | APPLY_HOOK (); | |
a98cef7e KN |
422 | NEXT; |
423 | } | |
424 | /* | |
425 | * Function call | |
426 | */ | |
3616e9e9 | 427 | if (!SCM_FALSEP (scm_procedure_p (x))) |
a98cef7e | 428 | { |
f41cb00c LC |
429 | /* At this point, the stack contains the procedure and each one of its |
430 | arguments. */ | |
f21dfea6 | 431 | SCM args; |
f41cb00c | 432 | |
135b32ee | 433 | #if 1 |
17e90c5e | 434 | POP_LIST (nargs); |
135b32ee LC |
435 | #else |
436 | /* Experimental: Build the arglist on the VM stack. XXX */ | |
437 | POP_LIST_ON_STACK (nargs); | |
438 | #endif | |
f21dfea6 KN |
439 | POP (args); |
440 | *sp = scm_apply (x, args, SCM_EOL); | |
17e90c5e | 441 | NEXT; |
a98cef7e KN |
442 | } |
443 | /* | |
444 | * Continuation call | |
445 | */ | |
3616e9e9 | 446 | if (SCM_VM_CONT_P (x)) |
a98cef7e KN |
447 | { |
448 | vm_call_cc: | |
449 | /* Check the number of arguments */ | |
382693fe | 450 | if (nargs != 1) |
3616e9e9 | 451 | scm_wrong_num_args (x); |
a98cef7e KN |
452 | |
453 | /* Reinstate the continuation */ | |
17e90c5e | 454 | EXIT_HOOK (); |
3616e9e9 | 455 | reinstate_vm_cont (vp, x); |
3d5ee0cd | 456 | CACHE_REGISTER (); |
af988bbf | 457 | program = SCM_FRAME_PROGRAM (fp); |
3616e9e9 | 458 | CACHE_PROGRAM (); |
a98cef7e KN |
459 | NEXT; |
460 | } | |
461 | ||
66292535 | 462 | program = x; |
17e90c5e | 463 | goto vm_error_wrong_type_apply; |
a98cef7e KN |
464 | } |
465 | ||
46cd9a34 | 466 | VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1) |
a98cef7e | 467 | { |
f41cb00c | 468 | register SCM x; |
17e90c5e | 469 | nargs = FETCH (); |
3616e9e9 | 470 | x = sp[-nargs]; |
17e90c5e KN |
471 | |
472 | SCM_TICK; /* allow interrupt here */ | |
a98cef7e KN |
473 | |
474 | /* | |
17e90c5e | 475 | * Tail recursive call |
a98cef7e | 476 | */ |
17e90c5e | 477 | if (SCM_EQ_P (x, program)) |
a98cef7e | 478 | { |
f21dfea6 | 479 | int i; |
17e90c5e KN |
480 | |
481 | /* Move arguments */ | |
f21dfea6 KN |
482 | INIT_ARGS (); |
483 | sp -= bp->nargs - 1; | |
484 | for (i = 0; i < bp->nargs; i++) | |
485 | LOCAL_SET (i, sp[i]); | |
f41cb00c LC |
486 | |
487 | /* Drop the first argument and the program itself. */ | |
488 | sp -= 2; | |
a98cef7e | 489 | |
f21dfea6 | 490 | /* Call itself */ |
17e90c5e | 491 | ip = bp->base; |
17e90c5e | 492 | APPLY_HOOK (); |
a98cef7e KN |
493 | NEXT; |
494 | } | |
17e90c5e KN |
495 | /* |
496 | * Proper tail call | |
497 | */ | |
3616e9e9 | 498 | if (SCM_PROGRAM_P (x)) |
17e90c5e | 499 | { |
17e90c5e KN |
500 | EXIT_HOOK (); |
501 | FREE_FRAME (); | |
3616e9e9 | 502 | program = x; |
3d5ee0cd | 503 | goto vm_call_program; |
17e90c5e | 504 | } |
a98cef7e KN |
505 | /* |
506 | * Function call | |
507 | */ | |
3616e9e9 | 508 | if (!SCM_FALSEP (scm_procedure_p (x))) |
a98cef7e | 509 | { |
f21dfea6 | 510 | SCM args; |
17e90c5e | 511 | POP_LIST (nargs); |
f21dfea6 KN |
512 | POP (args); |
513 | *sp = scm_apply (x, args, SCM_EOL); | |
a98cef7e KN |
514 | goto vm_return; |
515 | } | |
516 | /* | |
517 | * Continuation call | |
518 | */ | |
3616e9e9 | 519 | if (SCM_VM_CONT_P (x)) |
a98cef7e KN |
520 | goto vm_call_cc; |
521 | ||
66292535 | 522 | program = x; |
17e90c5e KN |
523 | goto vm_error_wrong_type_apply; |
524 | } | |
525 | ||
3616e9e9 KN |
526 | VM_DEFINE_INSTRUCTION (apply, "apply", 1, -1, 1) |
527 | { | |
c8b9df71 KN |
528 | int len; |
529 | SCM ls; | |
530 | POP (ls); | |
531 | ||
532 | nargs = FETCH (); | |
533 | if (nargs < 2) | |
534 | goto vm_error_wrong_num_args; | |
535 | ||
536 | len = scm_ilength (ls); | |
537 | if (len < 0) | |
538 | goto vm_error_wrong_type_arg; | |
539 | ||
540 | for (; !SCM_NULLP (ls); ls = SCM_CDR (ls)) | |
541 | PUSH (SCM_CAR (ls)); | |
542 | ||
543 | nargs += len - 2; | |
544 | goto vm_call; | |
3616e9e9 KN |
545 | } |
546 | ||
46cd9a34 | 547 | VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1, 1, 1) |
17e90c5e | 548 | { |
3d5ee0cd KN |
549 | SYNC_BEFORE_GC (); |
550 | PUSH (capture_vm_cont (vp)); | |
17e90c5e KN |
551 | POP (program); |
552 | nargs = 1; | |
553 | goto vm_call; | |
a98cef7e KN |
554 | } |
555 | ||
46cd9a34 | 556 | VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1) |
a98cef7e | 557 | { |
a98cef7e | 558 | vm_return: |
17e90c5e KN |
559 | EXIT_HOOK (); |
560 | RETURN_HOOK (); | |
561 | FREE_FRAME (); | |
562 | ||
15df3447 | 563 | /* Restore the last program */ |
af988bbf | 564 | program = SCM_FRAME_PROGRAM (fp); |
499a4c07 | 565 | CACHE_PROGRAM (); |
af988bbf | 566 | CACHE_EXTERNAL (); |
a98cef7e KN |
567 | NEXT; |
568 | } | |
17e90c5e | 569 | |
17e90c5e KN |
570 | /* |
571 | Local Variables: | |
572 | c-file-style: "gnu" | |
573 | End: | |
574 | */ |