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