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