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