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