top level fixes
[bpt/guile.git] / libguile / vm-engine.c
CommitLineData
475772ea
MW
1/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013,
2 * 2014 Free Software Foundation, Inc.
a98cef7e 3 *
560b9c25 4 * This library is free software; you can redistribute it and/or
53befeb7
NJ
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
a98cef7e 8 *
53befeb7
NJ
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
560b9c25
AW
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
a98cef7e 13 *
560b9c25
AW
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
53befeb7
NJ
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17 * 02110-1301 USA
560b9c25 18 */
a98cef7e 19
510ca126
AW
20/* This file is included in vm.c multiple times. */
21
22
6ed55e91 23#define UNPACK_8_8_8(op,a,b,c) \
20b1b913
AW
24 do \
25 { \
26 a = (op >> 8) & 0xff; \
27 b = (op >> 16) & 0xff; \
28 c = op >> 24; \
29 } \
30 while (0)
31
6ed55e91 32#define UNPACK_8_16(op,a,b) \
20b1b913
AW
33 do \
34 { \
35 a = (op >> 8) & 0xff; \
36 b = op >> 16; \
37 } \
38 while (0)
39
6ed55e91 40#define UNPACK_16_8(op,a,b) \
20b1b913
AW
41 do \
42 { \
43 a = (op >> 8) & 0xffff; \
44 b = op >> 24; \
45 } \
46 while (0)
47
6ed55e91 48#define UNPACK_12_12(op,a,b) \
20b1b913
AW
49 do \
50 { \
51 a = (op >> 8) & 0xfff; \
52 b = op >> 20; \
53 } \
54 while (0)
55
6ed55e91 56#define UNPACK_24(op,a) \
20b1b913
AW
57 do \
58 { \
59 a = op >> 8; \
60 } \
61 while (0)
62
63
8dd6bfa7
AW
64/* Assign some registers by hand. There used to be a bigger list here,
65 but it was never tested, and in the case of x86-32, was a source of
66 compilation failures. It can be revived if it's useful, but my naive
67 hope is that simply annotating the locals with "register" will be a
68 sufficient hint to the compiler. */
eac12024 69#ifdef __GNUC__
8dd6bfa7 70# if defined __x86_64__
eac12024
AW
71/* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
72 well. Tell it to keep the jump table in a r12, which is
73 callee-saved. */
8dd6bfa7
AW
74# define JT_REG asm ("r12")
75# endif
eac12024
AW
76#endif
77
78#ifndef IP_REG
8dd6bfa7 79# define IP_REG
eac12024 80#endif
eac12024 81#ifndef FP_REG
8dd6bfa7 82# define FP_REG
eac12024
AW
83#endif
84#ifndef JT_REG
8dd6bfa7 85# define JT_REG
eac12024
AW
86#endif
87
6ed55e91
AW
88#define VM_ASSERT(condition, handler) \
89 do { \
90 if (SCM_UNLIKELY (!(condition))) \
91 { \
56280be9 92 SYNC_IP(); \
6ed55e91
AW
93 handler; \
94 } \
27c7c630 95 } while (0)
eac12024
AW
96
97#ifdef VM_ENABLE_ASSERTIONS
98# define ASSERT(condition) VM_ASSERT (condition, abort())
99#else
100# define ASSERT(condition)
101#endif
102
c850a0ff 103#if VM_USE_HOOKS
ea0cd17d 104#define RUN_HOOK(exp) \
c850a0ff
AW
105 do { \
106 if (SCM_UNLIKELY (vp->trace_level > 0)) \
107 { \
56280be9 108 SYNC_IP (); \
ea0cd17d 109 exp; \
4a1ce016 110 CACHE_FP (); \
c850a0ff
AW
111 } \
112 } while (0)
113#else
ea0cd17d 114#define RUN_HOOK(exp)
c850a0ff 115#endif
59f85eed
AW
116#define RUN_HOOK0(h) RUN_HOOK (vm_dispatch_##h##_hook (vp))
117#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (vp, arg))
c850a0ff
AW
118
119#define APPLY_HOOK() \
ea0cd17d 120 RUN_HOOK0 (apply)
c850a0ff 121#define PUSH_CONTINUATION_HOOK() \
ea0cd17d 122 RUN_HOOK0 (push_continuation)
b636cdb0 123#define POP_CONTINUATION_HOOK(old_fp) \
ea0cd17d 124 RUN_HOOK1 (pop_continuation, old_fp)
c850a0ff 125#define NEXT_HOOK() \
ea0cd17d 126 RUN_HOOK0 (next)
b636cdb0 127#define ABORT_CONTINUATION_HOOK() \
ea0cd17d 128 RUN_HOOK0 (abort)
c850a0ff
AW
129
130#define VM_HANDLE_INTERRUPTS \
12432c86 131 SCM_ASYNC_TICK_WITH_GUARD_CODE (current_thread, SYNC_IP (), CACHE_FP ())
c850a0ff
AW
132
133
510ca126
AW
134/* Virtual Machine
135
c2ae85be 136 The VM has three state bits: the instruction pointer (IP), the frame
510ca126
AW
137 pointer (FP), and the top-of-stack pointer (SP). We cache the first
138 two of these in machine registers, local to the VM, because they are
139 used extensively by the VM. As the SP is used more by code outside
140 the VM than by the VM itself, we don't bother caching it locally.
141
142 Since the FP changes infrequently, relative to the IP, we keep vp->fp
143 in sync with the local FP. This would be a big lose for the IP,
144 though, so instead of updating vp->ip all the time, we call SYNC_IP
145 whenever we would need to know the IP of the top frame. In practice,
146 we need to SYNC_IP whenever we call out of the VM to a function that
147 would like to walk the stack, perhaps as the result of an
4a1ce016
AW
148 exception.
149
150 One more thing. We allow the stack to move, when it expands.
151 Therefore if you call out to a C procedure that could call Scheme
152 code, or otherwise push anything on the stack, you will need to
153 CACHE_FP afterwards to restore the possibly-changed FP. */
510ca126 154
56280be9 155#define SYNC_IP() vp->ip = (ip)
510ca126 156
4a1ce016
AW
157#define CACHE_FP() fp = (vp->fp)
158#define CACHE_REGISTER() \
159 do { \
160 ip = vp->ip; \
161 fp = vp->fp; \
162 } while (0)
163
164
510ca126 165/* Reserve stack space for a frame. Will check that there is sufficient
b636cdb0 166 stack space for N locals, including the procedure. Invoke after
c2ae85be
AW
167 preparing the new frame and setting the fp and ip.
168
169 If there is not enough space for this frame, we try to expand the
170 stack, possibly relocating it somewhere else in the address space.
171 Because of the possible relocation, no pointer into the stack besides
172 FP is valid across an ALLOC_FRAME call. Be careful! */
510ca126
AW
173#define ALLOC_FRAME(n) \
174 do { \
c2ae85be
AW
175 SCM *new_sp = LOCAL_ADDRESS (n - 1); \
176 if (new_sp > vp->sp_max_since_gc) \
b914b236 177 { \
c2ae85be
AW
178 if (SCM_UNLIKELY (new_sp >= vp->stack_limit)) \
179 { \
180 SYNC_IP (); \
181 vm_expand_stack (vp, new_sp); \
182 CACHE_FP (); \
183 } \
184 else \
185 vp->sp_max_since_gc = vp->sp = new_sp; \
b914b236 186 } \
c2ae85be
AW
187 else \
188 vp->sp = new_sp; \
510ca126
AW
189 } while (0)
190
191/* Reset the current frame to hold N locals. Used when we know that no
192 stack expansion is needed. */
193#define RESET_FRAME(n) \
194 do { \
b636cdb0 195 vp->sp = LOCAL_ADDRESS (n - 1); \
7dba1c2f
AW
196 if (vp->sp > vp->sp_max_since_gc) \
197 vp->sp_max_since_gc = vp->sp; \
510ca126
AW
198 } while (0)
199
b636cdb0
AW
200/* Compute the number of locals in the frame. At a call, this is equal
201 to the number of actual arguments when a function is first called,
202 plus one for the function. */
203#define FRAME_LOCALS_COUNT_FROM(slot) \
204 (vp->sp + 1 - LOCAL_ADDRESS (slot))
205#define FRAME_LOCALS_COUNT() \
206 FRAME_LOCALS_COUNT_FROM (0)
510ca126
AW
207
208/* Restore registers after returning from a frame. */
209#define RESTORE_FRAME() \
210 do { \
211 } while (0)
212
213
510ca126
AW
214#ifdef HAVE_LABELS_AS_VALUES
215# define BEGIN_DISPATCH_SWITCH /* */
216# define END_DISPATCH_SWITCH /* */
217# define NEXT(n) \
218 do \
219 { \
220 ip += n; \
221 NEXT_HOOK (); \
222 op = *ip; \
223 goto *jump_table[op & 0xff]; \
224 } \
225 while (0)
226# define VM_DEFINE_OP(opcode, tag, name, meta) \
227 op_##tag:
228#else
229# define BEGIN_DISPATCH_SWITCH \
230 vm_start: \
231 NEXT_HOOK (); \
232 op = *ip; \
233 switch (op & 0xff) \
234 {
235# define END_DISPATCH_SWITCH \
510ca126
AW
236 }
237# define NEXT(n) \
238 do \
239 { \
240 ip += n; \
241 goto vm_start; \
242 } \
243 while (0)
244# define VM_DEFINE_OP(opcode, tag, name, meta) \
245 op_##tag: \
246 case opcode:
247#endif
248
b636cdb0
AW
249#define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
250#define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
251#define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
510ca126
AW
252
253#define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
254#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
255#define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
510ca126
AW
256
257#define RETURN_ONE_VALUE(ret) \
258 do { \
259 SCM val = ret; \
4a1ce016 260 SCM *old_fp; \
510ca126 261 VM_HANDLE_INTERRUPTS; \
4a1ce016 262 old_fp = fp; \
9121d9f1 263 ip = SCM_FRAME_RETURN_ADDRESS (fp); \
510ca126 264 fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
af95414f 265 /* Clear frame. */ \
b636cdb0
AW
266 old_fp[-1] = SCM_BOOL_F; \
267 old_fp[-2] = SCM_BOOL_F; \
af95414f 268 /* Leave proc. */ \
b636cdb0
AW
269 SCM_FRAME_LOCAL (old_fp, 1) = val; \
270 vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
271 POP_CONTINUATION_HOOK (old_fp); \
510ca126
AW
272 NEXT (0); \
273 } while (0)
274
275/* While we could generate the list-unrolling code here, it's fine for
276 now to just tail-call (apply values vals). */
277#define RETURN_VALUE_LIST(vals_) \
278 do { \
279 SCM vals = vals_; \
280 VM_HANDLE_INTERRUPTS; \
b636cdb0
AW
281 fp[0] = vm_builtin_apply; \
282 fp[1] = vm_builtin_values; \
283 fp[2] = vals; \
7396d216 284 RESET_FRAME (3); \
486013d6 285 ip = (scm_t_uint32 *) vm_builtin_apply_code; \
adb8d905 286 goto op_tail_apply; \
510ca126
AW
287 } while (0)
288
289#define BR_NARGS(rel) \
d2bd8fa8 290 scm_t_uint32 expected; \
20b1b913 291 UNPACK_24 (op, expected); \
510ca126
AW
292 if (FRAME_LOCALS_COUNT() rel expected) \
293 { \
294 scm_t_int32 offset = ip[1]; \
295 offset >>= 8; /* Sign-extending shift. */ \
296 NEXT (offset); \
297 } \
298 NEXT (2)
299
300#define BR_UNARY(x, exp) \
301 scm_t_uint32 test; \
302 SCM x; \
20b1b913 303 UNPACK_24 (op, test); \
510ca126
AW
304 x = LOCAL_REF (test); \
305 if ((ip[1] & 0x1) ? !(exp) : (exp)) \
306 { \
307 scm_t_int32 offset = ip[1]; \
308 offset >>= 8; /* Sign-extending shift. */ \
fcd3c8cc 309 if (offset <= 0) \
510ca126
AW
310 VM_HANDLE_INTERRUPTS; \
311 NEXT (offset); \
312 } \
313 NEXT (2)
314
315#define BR_BINARY(x, y, exp) \
316 scm_t_uint16 a, b; \
317 SCM x, y; \
20b1b913 318 UNPACK_12_12 (op, a, b); \
510ca126
AW
319 x = LOCAL_REF (a); \
320 y = LOCAL_REF (b); \
321 if ((ip[1] & 0x1) ? !(exp) : (exp)) \
322 { \
323 scm_t_int32 offset = ip[1]; \
324 offset >>= 8; /* Sign-extending shift. */ \
fcd3c8cc 325 if (offset <= 0) \
510ca126
AW
326 VM_HANDLE_INTERRUPTS; \
327 NEXT (offset); \
328 } \
329 NEXT (2)
330
331#define BR_ARITHMETIC(crel,srel) \
332 { \
333 scm_t_uint16 a, b; \
334 SCM x, y; \
20b1b913 335 UNPACK_12_12 (op, a, b); \
510ca126
AW
336 x = LOCAL_REF (a); \
337 y = LOCAL_REF (b); \
338 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
339 { \
340 scm_t_signed_bits x_bits = SCM_UNPACK (x); \
341 scm_t_signed_bits y_bits = SCM_UNPACK (y); \
af95414f 342 if ((ip[1] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \
510ca126
AW
343 { \
344 scm_t_int32 offset = ip[1]; \
345 offset >>= 8; /* Sign-extending shift. */ \
fcd3c8cc 346 if (offset <= 0) \
510ca126
AW
347 VM_HANDLE_INTERRUPTS; \
348 NEXT (offset); \
349 } \
350 NEXT (2); \
351 } \
352 else \
353 { \
af95414f 354 SCM res; \
510ca126 355 SYNC_IP (); \
af95414f 356 res = srel (x, y); \
4a1ce016 357 CACHE_FP (); \
af95414f 358 if ((ip[1] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \
510ca126
AW
359 { \
360 scm_t_int32 offset = ip[1]; \
361 offset >>= 8; /* Sign-extending shift. */ \
fcd3c8cc 362 if (offset <= 0) \
510ca126
AW
363 VM_HANDLE_INTERRUPTS; \
364 NEXT (offset); \
365 } \
366 NEXT (2); \
367 } \
368 }
369
370#define ARGS1(a1) \
371 scm_t_uint16 dst, src; \
372 SCM a1; \
20b1b913 373 UNPACK_12_12 (op, dst, src); \
510ca126
AW
374 a1 = LOCAL_REF (src)
375#define ARGS2(a1, a2) \
376 scm_t_uint8 dst, src1, src2; \
377 SCM a1, a2; \
20b1b913 378 UNPACK_8_8_8 (op, dst, src1, src2); \
510ca126
AW
379 a1 = LOCAL_REF (src1); \
380 a2 = LOCAL_REF (src2)
381#define RETURN(x) \
382 do { LOCAL_SET (dst, x); NEXT (1); } while (0)
4a1ce016
AW
383#define RETURN_EXP(exp) \
384 do { SCM __x; SYNC_IP (); __x = exp; CACHE_FP (); RETURN (__x); } while (0)
510ca126
AW
385
386/* The maximum/minimum tagged integers. */
d2295ba5
MW
387#define INUM_MAX \
388 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
389#define INUM_MIN \
390 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
391#define INUM_STEP \
392 ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
393 - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
510ca126
AW
394
395#define BINARY_INTEGER_OP(CFUNC,SFUNC) \
396 { \
397 ARGS2 (x, y); \
398 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
399 { \
400 scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \
401 if (SCM_FIXABLE (n)) \
402 RETURN (SCM_I_MAKINUM (n)); \
403 } \
4a1ce016 404 RETURN_EXP (SFUNC (x, y)); \
510ca126
AW
405 }
406
407#define VM_VALIDATE_PAIR(x, proc) \
408 VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x))
409
410#define VM_VALIDATE_STRUCT(obj, proc) \
411 VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
412
413#define VM_VALIDATE_BYTEVECTOR(x, proc) \
414 VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x))
415
416/* Return true (non-zero) if PTR has suitable alignment for TYPE. */
417#define ALIGNED_P(ptr, type) \
418 ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
419
420static SCM
12432c86 421VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
dd1c7dec 422 scm_i_jmp_buf *registers, int resume)
510ca126
AW
423{
424 /* Instruction pointer: A pointer to the opcode that is currently
425 running. */
426 register scm_t_uint32 *ip IP_REG;
427
428 /* Frame pointer: A pointer into the stack, off of which we index
429 arguments and local variables. Pushed at function calls, popped on
430 returns. */
431 register SCM *fp FP_REG;
432
433 /* Current opcode: A cache of *ip. */
434 register scm_t_uint32 op;
435
510ca126 436#ifdef HAVE_LABELS_AS_VALUES
d86682ba
AW
437 static const void *jump_table_[256] = {
438#define LABEL_ADDR(opcode, tag, name, meta) &&op_##tag,
439 FOR_EACH_VM_OPERATION(LABEL_ADDR)
440#undef LABEL_ADDR
441 };
510ca126 442 register const void **jump_table JT_REG;
510ca126
AW
443 /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
444 load instruction at each instruction dispatch. */
d86682ba 445 jump_table = jump_table_;
510ca126
AW
446#endif
447
bd63e5b2 448 /* Load VM registers. */
510ca126
AW
449 CACHE_REGISTER ();
450
451 VM_HANDLE_INTERRUPTS;
452
dd1c7dec
AW
453 /* Usually a call to the VM happens on application, with the boot
454 continuation on the next frame. Sometimes it happens after a
455 non-local exit however; in that case the VM state is all set up,
456 and we have but to jump to the next opcode. */
457 if (SCM_UNLIKELY (resume))
458 NEXT (0);
459
510ca126 460 apply:
73fc4e73 461 while (!SCM_PROGRAM_P (LOCAL_REF (0)))
510ca126 462 {
73fc4e73 463 SCM proc = LOCAL_REF (0);
510ca126
AW
464
465 if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
466 {
b636cdb0 467 LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc));
510ca126
AW
468 continue;
469 }
470 if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
471 {
472 scm_t_uint32 n = FRAME_LOCALS_COUNT();
473
9d87158f
AW
474 /* Shuffle args up. */
475 RESET_FRAME (n + 1);
510ca126
AW
476 while (n--)
477 LOCAL_SET (n + 1, LOCAL_REF (n));
510ca126 478
9d87158f 479 LOCAL_SET (0, SCM_SMOB_DESCRIPTOR (proc).apply_trampoline);
510ca126
AW
480 continue;
481 }
482
483 SYNC_IP();
484 vm_error_wrong_type_apply (proc);
510ca126
AW
485 }
486
487 /* Let's go! */
73fc4e73 488 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
489
490 APPLY_HOOK ();
491
510ca126
AW
492 NEXT (0);
493
494 BEGIN_DISPATCH_SWITCH;
495
496
497 \f
498
499 /*
500 * Call and return
501 */
502
503 /* halt _:24
504 *
af95414f 505 * Bring the VM to a halt, returning all the values from the stack.
510ca126
AW
506 */
507 VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
508 {
f8085163 509 /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
510ca126 510
b636cdb0
AW
511 scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
512 SCM ret;
513
af95414f 514 if (nvals == 1)
f8085163 515 ret = LOCAL_REF (4);
af95414f
AW
516 else
517 {
518 scm_t_uint32 n;
519 ret = SCM_EOL;
af95414f 520 for (n = nvals; n > 0; n--)
12432c86 521 ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
af95414f
AW
522 ret = scm_values (ret);
523 }
510ca126
AW
524
525 vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
b636cdb0 526 vp->sp = SCM_FRAME_PREVIOUS_SP (fp);
510ca126
AW
527 vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
528
af95414f 529 return ret;
286a0fb3
AW
530 }
531
af95414f 532 /* call proc:24 _:8 nlocals:24
286a0fb3 533 *
af95414f 534 * Call a procedure. PROC is the local corresponding to a procedure.
ddf0d7bb 535 * The two values below PROC will be overwritten by the saved call
af95414f
AW
536 * frame data. The new frame will have space for NLOCALS locals: one
537 * for the procedure, and the rest for the arguments which should
538 * already have been pushed on.
510ca126 539 *
af95414f
AW
540 * When the call returns, execution proceeds with the next
541 * instruction. There may be any number of values on the return
542 * stack; the precise number can be had by subtracting the address of
543 * PROC from the post-call SP.
510ca126 544 */
af95414f 545 VM_DEFINE_OP (1, call, "call", OP2 (U8_U24, X8_U24))
510ca126 546 {
af95414f 547 scm_t_uint32 proc, nlocals;
4a1ce016 548 SCM *old_fp;
510ca126 549
20b1b913
AW
550 UNPACK_24 (op, proc);
551 UNPACK_24 (ip[1], nlocals);
510ca126
AW
552
553 VM_HANDLE_INTERRUPTS;
554
f5cb70e9
AW
555 PUSH_CONTINUATION_HOOK ();
556
4a1ce016 557 old_fp = fp;
af95414f 558 fp = vp->fp = old_fp + proc;
510ca126 559 SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
9121d9f1 560 SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
510ca126 561
af95414f
AW
562 RESET_FRAME (nlocals);
563
73fc4e73 564 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
510ca126
AW
565 goto apply;
566
73fc4e73 567 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
568
569 APPLY_HOOK ();
570
510ca126
AW
571 NEXT (0);
572 }
573
b3ae2b50
AW
574 /* call-label proc:24 _:8 nlocals:24 label:32
575 *
576 * Call a procedure in the same compilation unit.
577 *
578 * This instruction is just like "call", except that instead of
579 * dereferencing PROC to find the call target, the call target is
580 * known to be at LABEL, a signed 32-bit offset in 32-bit units from
581 * the current IP. Since PROC is not dereferenced, it may be some
582 * other representation of the closure.
583 */
584 VM_DEFINE_OP (2, call_label, "call-label", OP3 (U8_U24, X8_U24, L32))
585 {
586 scm_t_uint32 proc, nlocals;
587 scm_t_int32 label;
588 SCM *old_fp;
589
590 UNPACK_24 (op, proc);
591 UNPACK_24 (ip[1], nlocals);
592 label = ip[2];
593
594 VM_HANDLE_INTERRUPTS;
595
f5cb70e9
AW
596 PUSH_CONTINUATION_HOOK ();
597
b3ae2b50
AW
598 old_fp = fp;
599 fp = vp->fp = old_fp + proc;
600 SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
601 SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 3);
602
603 RESET_FRAME (nlocals);
604
f5cb70e9
AW
605 ip += label;
606
b3ae2b50
AW
607 APPLY_HOOK ();
608
f5cb70e9 609 NEXT (0);
b3ae2b50
AW
610 }
611
af95414f 612 /* tail-call nlocals:24
510ca126 613 *
af95414f 614 * Tail-call a procedure. Requires that the procedure and all of the
486013d6
AW
615 * arguments have already been shuffled into position. Will reset the
616 * frame to NLOCALS.
510ca126 617 */
b3ae2b50 618 VM_DEFINE_OP (3, tail_call, "tail-call", OP1 (U8_U24))
510ca126 619 {
af95414f
AW
620 scm_t_uint32 nlocals;
621
20b1b913 622 UNPACK_24 (op, nlocals);
510ca126
AW
623
624 VM_HANDLE_INTERRUPTS;
625
af95414f 626 RESET_FRAME (nlocals);
486013d6 627
73fc4e73 628 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
486013d6
AW
629 goto apply;
630
73fc4e73 631 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
632
633 APPLY_HOOK ();
634
486013d6
AW
635 NEXT (0);
636 }
637
b3ae2b50
AW
638 /* tail-call-label nlocals:24 label:32
639 *
640 * Tail-call a known procedure. As call is to call-label, tail-call
641 * is to tail-call-label.
642 */
643 VM_DEFINE_OP (4, tail_call_label, "tail-call-label", OP2 (U8_U24, L32))
644 {
645 scm_t_uint32 nlocals;
646 scm_t_int32 label;
647
648 UNPACK_24 (op, nlocals);
649 label = ip[1];
650
651 VM_HANDLE_INTERRUPTS;
652
653 RESET_FRAME (nlocals);
654
f5cb70e9
AW
655 ip += label;
656
b3ae2b50
AW
657 APPLY_HOOK ();
658
f5cb70e9 659 NEXT (0);
b3ae2b50
AW
660 }
661
486013d6
AW
662 /* tail-call/shuffle from:24
663 *
664 * Tail-call a procedure. The procedure should already be set to slot
665 * 0. The rest of the args are taken from the frame, starting at
666 * FROM, shuffled down to start at slot 0. This is part of the
667 * implementation of the call-with-values builtin.
668 */
b3ae2b50 669 VM_DEFINE_OP (5, tail_call_shuffle, "tail-call/shuffle", OP1 (U8_U24))
486013d6
AW
670 {
671 scm_t_uint32 n, from, nlocals;
672
20b1b913 673 UNPACK_24 (op, from);
486013d6
AW
674
675 VM_HANDLE_INTERRUPTS;
676
677 VM_ASSERT (from > 0, abort ());
678 nlocals = FRAME_LOCALS_COUNT ();
679
680 for (n = 0; from + n < nlocals; n++)
681 LOCAL_SET (n + 1, LOCAL_REF (from + n));
682
683 RESET_FRAME (n + 1);
684
73fc4e73 685 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
510ca126
AW
686 goto apply;
687
73fc4e73 688 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
689
690 APPLY_HOOK ();
691
510ca126
AW
692 NEXT (0);
693 }
694
af95414f 695 /* receive dst:12 proc:12 _:8 nlocals:24
510ca126 696 *
af95414f
AW
697 * Receive a single return value from a call whose procedure was in
698 * PROC, asserting that the call actually returned at least one
699 * value. Afterwards, resets the frame to NLOCALS locals.
510ca126 700 */
b3ae2b50 701 VM_DEFINE_OP (6, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
510ca126 702 {
af95414f
AW
703 scm_t_uint16 dst, proc;
704 scm_t_uint32 nlocals;
20b1b913
AW
705 UNPACK_12_12 (op, dst, proc);
706 UNPACK_24 (ip[1], nlocals);
af95414f
AW
707 VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ());
708 LOCAL_SET (dst, LOCAL_REF (proc + 1));
709 RESET_FRAME (nlocals);
710 NEXT (2);
711 }
510ca126 712
82f4bac4 713 /* receive-values proc:24 allow-extra?:1 _:7 nvalues:24
af95414f
AW
714 *
715 * Receive a return of multiple values from a call whose procedure was
716 * in PROC. If fewer than NVALUES values were returned, signal an
82f4bac4
AW
717 * error. Unless ALLOW-EXTRA? is true, require that the number of
718 * return values equals NVALUES exactly. After receive-values has
719 * run, the values can be copied down via `mov'.
af95414f 720 */
b3ae2b50 721 VM_DEFINE_OP (7, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
af95414f
AW
722 {
723 scm_t_uint32 proc, nvalues;
20b1b913
AW
724 UNPACK_24 (op, proc);
725 UNPACK_24 (ip[1], nvalues);
82f4bac4
AW
726 if (ip[1] & 0x1)
727 VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues,
728 vm_error_not_enough_values ());
729 else
186b56c4 730 VM_ASSERT (FRAME_LOCALS_COUNT () == proc + 1 + nvalues,
82f4bac4 731 vm_error_wrong_number_of_values (nvalues));
af95414f 732 NEXT (2);
510ca126
AW
733 }
734
735 /* return src:24
736 *
737 * Return a value.
738 */
b3ae2b50 739 VM_DEFINE_OP (8, return, "return", OP1 (U8_U24))
510ca126
AW
740 {
741 scm_t_uint32 src;
20b1b913 742 UNPACK_24 (op, src);
510ca126
AW
743 RETURN_ONE_VALUE (LOCAL_REF (src));
744 }
745
84cc4127 746 /* return-values _:24
510ca126
AW
747 *
748 * Return a number of values from a call frame. This opcode
749 * corresponds to an application of `values' in tail position. As
af95414f
AW
750 * with tail calls, we expect that the values have already been
751 * shuffled down to a contiguous array starting at slot 1.
84cc4127 752 * We also expect the frame has already been reset.
510ca126 753 */
b3ae2b50 754 VM_DEFINE_OP (9, return_values, "return-values", OP1 (U8_X24))
510ca126 755 {
4a1ce016 756 SCM *old_fp;
af95414f 757
af95414f 758 VM_HANDLE_INTERRUPTS;
4a1ce016
AW
759
760 old_fp = fp;
9121d9f1 761 ip = SCM_FRAME_RETURN_ADDRESS (fp);
af95414f
AW
762 fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
763
764 /* Clear stack frame. */
b636cdb0
AW
765 old_fp[-1] = SCM_BOOL_F;
766 old_fp[-2] = SCM_BOOL_F;
af95414f 767
b636cdb0 768 POP_CONTINUATION_HOOK (old_fp);
af95414f
AW
769
770 NEXT (0);
510ca126
AW
771 }
772
773
774 \f
775
776 /*
777 * Specialized call stubs
778 */
779
780 /* subr-call ptr-idx:24
781 *
782 * Call a subr, passing all locals in this frame as arguments. Fetch
783 * the foreign pointer from PTR-IDX, a free variable. Return from the
784 * calling frame. This instruction is part of the trampolines
785 * created in gsubr.c, and is not generated by the compiler.
786 */
b3ae2b50 787 VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (U8_U24))
510ca126
AW
788 {
789 scm_t_uint32 ptr_idx;
790 SCM pointer, ret;
791 SCM (*subr)();
792
20b1b913 793 UNPACK_24 (op, ptr_idx);
510ca126 794
d798a895 795 pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
510ca126
AW
796 subr = SCM_POINTER_VALUE (pointer);
797
510ca126
AW
798 SYNC_IP ();
799
b636cdb0 800 switch (FRAME_LOCALS_COUNT_FROM (1))
510ca126
AW
801 {
802 case 0:
803 ret = subr ();
804 break;
805 case 1:
b636cdb0 806 ret = subr (fp[1]);
510ca126
AW
807 break;
808 case 2:
b636cdb0 809 ret = subr (fp[1], fp[2]);
510ca126
AW
810 break;
811 case 3:
b636cdb0 812 ret = subr (fp[1], fp[2], fp[3]);
510ca126
AW
813 break;
814 case 4:
b636cdb0 815 ret = subr (fp[1], fp[2], fp[3], fp[4]);
510ca126
AW
816 break;
817 case 5:
b636cdb0 818 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
510ca126
AW
819 break;
820 case 6:
b636cdb0 821 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
510ca126
AW
822 break;
823 case 7:
b636cdb0 824 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
510ca126
AW
825 break;
826 case 8:
b636cdb0 827 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
510ca126
AW
828 break;
829 case 9:
b636cdb0 830 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]);
510ca126
AW
831 break;
832 case 10:
b636cdb0 833 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9], fp[10]);
510ca126
AW
834 break;
835 default:
836 abort ();
837 }
838
4a1ce016 839 CACHE_FP ();
510ca126
AW
840
841 if (SCM_UNLIKELY (SCM_VALUESP (ret)))
842 /* multiple values returned to continuation */
843 RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
844 else
845 RETURN_ONE_VALUE (ret);
846 }
847
848 /* foreign-call cif-idx:12 ptr-idx:12
849 *
850 * Call a foreign function. Fetch the CIF and foreign pointer from
851 * CIF-IDX and PTR-IDX, both free variables. Return from the calling
852 * frame. Arguments are taken from the stack. This instruction is
853 * part of the trampolines created by the FFI, and is not generated by
854 * the compiler.
855 */
b3ae2b50 856 VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (U8_U12_U12))
510ca126
AW
857 {
858 scm_t_uint16 cif_idx, ptr_idx;
7396d216 859 SCM closure, cif, pointer, ret;
510ca126 860
20b1b913 861 UNPACK_12_12 (op, cif_idx, ptr_idx);
510ca126 862
7396d216 863 closure = LOCAL_REF (0);
d798a895
AW
864 cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
865 pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
510ca126
AW
866
867 SYNC_IP ();
510ca126
AW
868
869 // FIXME: separate args
12432c86 870 ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
510ca126 871
4a1ce016 872 CACHE_FP ();
510ca126
AW
873
874 if (SCM_UNLIKELY (SCM_VALUESP (ret)))
875 /* multiple values returned to continuation */
876 RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
877 else
878 RETURN_ONE_VALUE (ret);
879 }
880
881 /* continuation-call contregs:24
882 *
883 * Return to a continuation, nonlocally. The arguments to the
884 * continuation are taken from the stack. CONTREGS is a free variable
885 * containing the reified continuation. This instruction is part of
886 * the implementation of undelimited continuations, and is not
887 * generated by the compiler.
888 */
b3ae2b50 889 VM_DEFINE_OP (12, continuation_call, "continuation-call", OP1 (U8_U24))
510ca126
AW
890 {
891 SCM contregs;
892 scm_t_uint32 contregs_idx;
893
20b1b913 894 UNPACK_24 (op, contregs_idx);
510ca126 895
7396d216 896 contregs =
d798a895 897 SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
510ca126
AW
898
899 SYNC_IP ();
900 scm_i_check_continuation (contregs);
796e54a7 901 vm_return_to_continuation (scm_i_contregs_vp (contregs),
510ca126 902 scm_i_contregs_vm_cont (contregs),
b636cdb0
AW
903 FRAME_LOCALS_COUNT_FROM (1),
904 LOCAL_ADDRESS (1));
510ca126
AW
905 scm_i_reinstate_continuation (contregs);
906
907 /* no NEXT */
908 abort ();
909 }
910
911 /* compose-continuation cont:24
912 *
913 * Compose a partial continution with the current continuation. The
914 * arguments to the continuation are taken from the stack. CONT is a
915 * free variable containing the reified continuation. This
916 * instruction is part of the implementation of partial continuations,
917 * and is not generated by the compiler.
918 */
b3ae2b50 919 VM_DEFINE_OP (13, compose_continuation, "compose-continuation", OP1 (U8_U24))
510ca126
AW
920 {
921 SCM vmcont;
922 scm_t_uint32 cont_idx;
923
20b1b913 924 UNPACK_24 (op, cont_idx);
d798a895 925 vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
510ca126
AW
926
927 SYNC_IP ();
928 VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
929 vm_error_continuation_not_rewindable (vmcont));
44ece399 930 vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1),
b636cdb0 931 LOCAL_ADDRESS (1),
12432c86 932 &current_thread->dynstack,
dd1c7dec 933 registers);
510ca126
AW
934 CACHE_REGISTER ();
935 NEXT (0);
936 }
937
adb8d905 938 /* tail-apply _:24
510ca126
AW
939 *
940 * Tail-apply the procedure in local slot 0 to the rest of the
941 * arguments. This instruction is part of the implementation of
942 * `apply', and is not generated by the compiler.
943 */
b3ae2b50 944 VM_DEFINE_OP (14, tail_apply, "tail-apply", OP1 (U8_X24))
510ca126 945 {
e93c0430 946 int i, list_idx, list_len, nlocals;
510ca126
AW
947 SCM list;
948
949 VM_HANDLE_INTERRUPTS;
950
e93c0430
AW
951 nlocals = FRAME_LOCALS_COUNT ();
952 // At a minimum, there should be apply, f, and the list.
953 VM_ASSERT (nlocals >= 3, abort ());
954 list_idx = nlocals - 1;
510ca126
AW
955 list = LOCAL_REF (list_idx);
956 list_len = scm_ilength (list);
957
958 VM_ASSERT (list_len >= 0, vm_error_apply_to_non_list (list));
959
e93c0430
AW
960 nlocals = nlocals - 2 + list_len;
961 ALLOC_FRAME (nlocals);
510ca126 962
e93c0430
AW
963 for (i = 1; i < list_idx; i++)
964 LOCAL_SET (i - 1, LOCAL_REF (i));
510ca126
AW
965
966 /* Null out these slots, just in case there are less than 2 elements
967 in the list. */
7396d216
AW
968 LOCAL_SET (list_idx - 1, SCM_UNDEFINED);
969 LOCAL_SET (list_idx, SCM_UNDEFINED);
510ca126
AW
970
971 for (i = 0; i < list_len; i++, list = SCM_CDR (list))
7396d216 972 LOCAL_SET (list_idx - 1 + i, SCM_CAR (list));
510ca126 973
73fc4e73 974 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
510ca126
AW
975 goto apply;
976
73fc4e73 977 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
978
979 APPLY_HOOK ();
980
510ca126
AW
981 NEXT (0);
982 }
983
984 /* call/cc _:24
985 *
986 * Capture the current continuation, and tail-apply the procedure in
d691ac20 987 * local slot 1 to it. This instruction is part of the implementation
510ca126
AW
988 * of `call/cc', and is not generated by the compiler.
989 */
b3ae2b50 990 VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (U8_X24))
510ca126
AW
991 {
992 SCM vm_cont, cont;
993 scm_t_dynstack *dynstack;
d691ac20 994 int first;
510ca126
AW
995
996 VM_HANDLE_INTERRUPTS;
997
998 SYNC_IP ();
12432c86 999 dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
510ca126
AW
1000 vm_cont = scm_i_vm_capture_stack (vp->stack_base,
1001 SCM_FRAME_DYNAMIC_LINK (fp),
b636cdb0 1002 SCM_FRAME_PREVIOUS_SP (fp),
510ca126 1003 SCM_FRAME_RETURN_ADDRESS (fp),
510ca126
AW
1004 dynstack,
1005 0);
d691ac20
AW
1006 /* FIXME: Seems silly to capture the registers here, when they are
1007 already captured in the registers local, which here we are
1008 copying out to the heap; and likewise, the setjmp(&registers)
1009 code already has the non-local return handler. But oh
1010 well! */
796e54a7 1011 cont = scm_i_make_continuation (&first, vp, vm_cont);
d691ac20
AW
1012
1013 if (first)
1014 {
1015 LOCAL_SET (0, LOCAL_REF (1));
1016 LOCAL_SET (1, cont);
1017 RESET_FRAME (2);
510ca126 1018
73fc4e73 1019 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
d691ac20 1020 goto apply;
510ca126 1021
73fc4e73 1022 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
1023
1024 APPLY_HOOK ();
1025
d691ac20
AW
1026 NEXT (0);
1027 }
1028 else
1029 {
1030 CACHE_REGISTER ();
b636cdb0 1031 ABORT_CONTINUATION_HOOK ();
d691ac20
AW
1032 NEXT (0);
1033 }
510ca126 1034 }
510ca126 1035
486013d6
AW
1036 /* abort _:24
1037 *
1038 * Abort to a prompt handler. The tag is expected in r1, and the rest
1039 * of the values in the frame are returned to the prompt handler.
1040 * This corresponds to a tail application of abort-to-prompt.
1041 */
b3ae2b50 1042 VM_DEFINE_OP (16, abort, "abort", OP1 (U8_X24))
486013d6
AW
1043 {
1044 scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
1045
1046 ASSERT (nlocals >= 2);
186b56c4
AW
1047 /* FIXME: Really we should capture the caller's registers. Until
1048 then, manually advance the IP so that when the prompt resumes,
1049 it continues with the next instruction. */
1050 ip++;
486013d6 1051 SYNC_IP ();
b44f5451 1052 vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
dd1c7dec 1053 SCM_EOL, LOCAL_ADDRESS (0), registers);
486013d6
AW
1054
1055 /* vm_abort should not return */
1056 abort ();
1057 }
1058
1059 /* builtin-ref dst:12 idx:12
1060 *
1061 * Load a builtin stub by index into DST.
1062 */
b3ae2b50 1063 VM_DEFINE_OP (17, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST)
486013d6
AW
1064 {
1065 scm_t_uint16 dst, idx;
1066
20b1b913 1067 UNPACK_12_12 (op, dst, idx);
486013d6
AW
1068 LOCAL_SET (dst, scm_vm_builtin_ref (idx));
1069
1070 NEXT (1);
1071 }
1072
510ca126
AW
1073
1074 \f
1075
1076 /*
1077 * Function prologues
1078 */
1079
1080 /* br-if-nargs-ne expected:24 _:8 offset:24
1081 * br-if-nargs-lt expected:24 _:8 offset:24
1082 * br-if-nargs-gt expected:24 _:8 offset:24
1083 *
1084 * If the number of actual arguments is not equal, less than, or greater
1085 * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
1086 * the current instruction pointer.
1087 */
b3ae2b50 1088 VM_DEFINE_OP (18, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
510ca126
AW
1089 {
1090 BR_NARGS (!=);
1091 }
b3ae2b50 1092 VM_DEFINE_OP (19, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
510ca126
AW
1093 {
1094 BR_NARGS (<);
1095 }
b3ae2b50 1096 VM_DEFINE_OP (20, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
510ca126
AW
1097 {
1098 BR_NARGS (>);
1099 }
1100
1101 /* assert-nargs-ee expected:24
1102 * assert-nargs-ge expected:24
1103 * assert-nargs-le expected:24
1104 *
1105 * If the number of actual arguments is not ==, >=, or <= EXPECTED,
1106 * respectively, signal an error.
1107 */
b3ae2b50 1108 VM_DEFINE_OP (21, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
510ca126
AW
1109 {
1110 scm_t_uint32 expected;
20b1b913 1111 UNPACK_24 (op, expected);
510ca126 1112 VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
73fc4e73 1113 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1114 NEXT (1);
1115 }
b3ae2b50 1116 VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
510ca126
AW
1117 {
1118 scm_t_uint32 expected;
20b1b913 1119 UNPACK_24 (op, expected);
510ca126 1120 VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
73fc4e73 1121 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1122 NEXT (1);
1123 }
b3ae2b50 1124 VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
510ca126
AW
1125 {
1126 scm_t_uint32 expected;
20b1b913 1127 UNPACK_24 (op, expected);
510ca126 1128 VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
73fc4e73 1129 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1130 NEXT (1);
1131 }
1132
af95414f 1133 /* alloc-frame nlocals:24
510ca126
AW
1134 *
1135 * Ensure that there is space on the stack for NLOCALS local variables,
1136 * setting them all to SCM_UNDEFINED, except those nargs values that
7396d216 1137 * were passed as arguments and procedure.
510ca126 1138 */
b3ae2b50 1139 VM_DEFINE_OP (24, alloc_frame, "alloc-frame", OP1 (U8_U24))
510ca126
AW
1140 {
1141 scm_t_uint32 nlocals, nargs;
20b1b913 1142 UNPACK_24 (op, nlocals);
510ca126
AW
1143
1144 nargs = FRAME_LOCALS_COUNT ();
1145 ALLOC_FRAME (nlocals);
1146 while (nlocals-- > nargs)
1147 LOCAL_SET (nlocals, SCM_UNDEFINED);
1148
1149 NEXT (1);
1150 }
1151
af95414f
AW
1152 /* reset-frame nlocals:24
1153 *
1154 * Like alloc-frame, but doesn't check that the stack is big enough.
1155 * Used to reset the frame size to something less than the size that
1156 * was previously set via alloc-frame.
1157 */
b3ae2b50 1158 VM_DEFINE_OP (25, reset_frame, "reset-frame", OP1 (U8_U24))
af95414f
AW
1159 {
1160 scm_t_uint32 nlocals;
20b1b913 1161 UNPACK_24 (op, nlocals);
af95414f
AW
1162 RESET_FRAME (nlocals);
1163 NEXT (1);
1164 }
1165
510ca126
AW
1166 /* assert-nargs-ee/locals expected:12 nlocals:12
1167 *
1168 * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
1169 * number of locals reserved is EXPECTED + NLOCALS.
1170 */
b3ae2b50 1171 VM_DEFINE_OP (26, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
510ca126
AW
1172 {
1173 scm_t_uint16 expected, nlocals;
20b1b913 1174 UNPACK_12_12 (op, expected, nlocals);
510ca126 1175 VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
73fc4e73 1176 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1177 ALLOC_FRAME (expected + nlocals);
1178 while (nlocals--)
1179 LOCAL_SET (expected + nlocals, SCM_UNDEFINED);
1180
1181 NEXT (1);
1182 }
1183
f90c0554
AW
1184 /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
1185 *
1186 * Find the first positional argument after NREQ. If it is greater
1187 * than NPOS, jump to OFFSET.
1188 *
1189 * This instruction is only emitted for functions with multiple
1190 * clauses, and an earlier clause has keywords and no rest arguments.
1191 * See "Case-lambda" in the manual, for more on how case-lambda
1192 * chooses the clause to apply.
1193 */
b3ae2b50 1194 VM_DEFINE_OP (27, br_if_npos_gt, "br-if-npos-gt", OP3 (U8_U24, X8_U24, X8_L24))
f90c0554
AW
1195 {
1196 scm_t_uint32 nreq, npos;
1197
20b1b913
AW
1198 UNPACK_24 (op, nreq);
1199 UNPACK_24 (ip[1], npos);
f90c0554
AW
1200
1201 /* We can only have too many positionals if there are more
1202 arguments than NPOS. */
1203 if (FRAME_LOCALS_COUNT() > npos)
1204 {
1205 scm_t_uint32 n;
1206 for (n = nreq; n < npos; n++)
1207 if (scm_is_keyword (LOCAL_REF (n)))
1208 break;
1209 if (n == npos && !scm_is_keyword (LOCAL_REF (n)))
1210 {
1211 scm_t_int32 offset = ip[2];
1212 offset >>= 8; /* Sign-extending shift. */
1213 NEXT (offset);
1214 }
1215 }
1216 NEXT (3);
1217 }
1218
02f9d496
AW
1219 /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
1220 *
1221 * flags := allow-other-keys:1 has-rest:1 _:6
510ca126
AW
1222 *
1223 * Find the last positional argument, and shuffle all the rest above
1224 * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then
1225 * load the constant at KW-OFFSET words from the current IP, and use it
1226 * to bind keyword arguments. If HAS-REST, collect all shuffled
1227 * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear
1228 * the arguments that we shuffled up.
1229 *
1230 * A macro-mega-instruction.
1231 */
b3ae2b50 1232 VM_DEFINE_OP (28, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32))
510ca126
AW
1233 {
1234 scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs;
1235 scm_t_int32 kw_offset;
1236 scm_t_bits kw_bits;
1237 SCM kw;
1238 char allow_other_keys, has_rest;
1239
20b1b913 1240 UNPACK_24 (op, nreq);
510ca126
AW
1241 allow_other_keys = ip[1] & 0x1;
1242 has_rest = ip[1] & 0x2;
20b1b913
AW
1243 UNPACK_24 (ip[1], nreq_and_opt);
1244 UNPACK_24 (ip[2], ntotal);
510ca126
AW
1245 kw_offset = ip[3];
1246 kw_bits = (scm_t_bits) (ip + kw_offset);
1247 VM_ASSERT (!(kw_bits & 0x7), abort());
1248 kw = SCM_PACK (kw_bits);
1249
1250 nargs = FRAME_LOCALS_COUNT ();
1251
1252 /* look in optionals for first keyword or last positional */
1253 /* starting after the last required positional arg */
1254 npositional = nreq;
1255 while (/* while we have args */
1256 npositional < nargs
1257 /* and we still have positionals to fill */
1258 && npositional < nreq_and_opt
1259 /* and we haven't reached a keyword yet */
1260 && !scm_is_keyword (LOCAL_REF (npositional)))
1261 /* bind this optional arg (by leaving it in place) */
1262 npositional++;
1263 nkw = nargs - npositional;
1264 /* shuffle non-positional arguments above ntotal */
1265 ALLOC_FRAME (ntotal + nkw);
1266 n = nkw;
1267 while (n--)
1268 LOCAL_SET (ntotal + n, LOCAL_REF (npositional + n));
1269 /* and fill optionals & keyword args with SCM_UNDEFINED */
1270 n = npositional;
1271 while (n < ntotal)
1272 LOCAL_SET (n++, SCM_UNDEFINED);
1273
1274 VM_ASSERT (has_rest || (nkw % 2) == 0,
73fc4e73 1275 vm_error_kwargs_length_not_even (LOCAL_REF (0)));
510ca126
AW
1276
1277 /* Now bind keywords, in the order given. */
1278 for (n = 0; n < nkw; n++)
1279 if (scm_is_keyword (LOCAL_REF (ntotal + n)))
1280 {
1281 SCM walk;
1282 for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk))
1283 if (scm_is_eq (SCM_CAAR (walk), LOCAL_REF (ntotal + n)))
1284 {
1285 SCM si = SCM_CDAR (walk);
1286 LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32 (si),
1287 LOCAL_REF (ntotal + n + 1));
1288 break;
1289 }
1290 VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
73fc4e73 1291 vm_error_kwargs_unrecognized_keyword (LOCAL_REF (0),
28d5d253 1292 LOCAL_REF (ntotal + n)));
510ca126
AW
1293 n++;
1294 }
1295 else
73fc4e73 1296 VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (LOCAL_REF (0),
28d5d253 1297 LOCAL_REF (ntotal + n)));
510ca126
AW
1298
1299 if (has_rest)
1300 {
1301 SCM rest = SCM_EOL;
1302 n = nkw;
1303 while (n--)
12432c86 1304 rest = scm_cons (LOCAL_REF (ntotal + n), rest);
510ca126
AW
1305 LOCAL_SET (nreq_and_opt, rest);
1306 }
1307
1308 RESET_FRAME (ntotal);
1309
1310 NEXT (4);
1311 }
1312
1313 /* bind-rest dst:24
1314 *
1315 * Collect any arguments at or above DST into a list, and store that
1316 * list at DST.
1317 */
b3ae2b50 1318 VM_DEFINE_OP (29, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
510ca126
AW
1319 {
1320 scm_t_uint32 dst, nargs;
1321 SCM rest = SCM_EOL;
1322
20b1b913 1323 UNPACK_24 (op, dst);
510ca126
AW
1324 nargs = FRAME_LOCALS_COUNT ();
1325
234155e3 1326 if (nargs <= dst)
510ca126 1327 {
234155e3
AW
1328 ALLOC_FRAME (dst + 1);
1329 while (nargs < dst)
1330 LOCAL_SET (nargs++, SCM_UNDEFINED);
510ca126 1331 }
234155e3
AW
1332 else
1333 {
1334 while (nargs-- > dst)
1335 {
12432c86 1336 rest = scm_cons (LOCAL_REF (nargs), rest);
234155e3
AW
1337 LOCAL_SET (nargs, SCM_UNDEFINED);
1338 }
510ca126 1339
234155e3
AW
1340 RESET_FRAME (dst + 1);
1341 }
510ca126 1342
234155e3 1343 LOCAL_SET (dst, rest);
510ca126
AW
1344
1345 NEXT (1);
1346 }
1347
510ca126
AW
1348
1349 \f
1350
1351 /*
1352 * Branching instructions
1353 */
1354
1355 /* br offset:24
1356 *
1357 * Add OFFSET, a signed 24-bit number, to the current instruction
1358 * pointer.
1359 */
b3ae2b50 1360 VM_DEFINE_OP (30, br, "br", OP1 (U8_L24))
510ca126
AW
1361 {
1362 scm_t_int32 offset = op;
1363 offset >>= 8; /* Sign-extending shift. */
fcd3c8cc
AW
1364 if (offset <= 0)
1365 VM_HANDLE_INTERRUPTS;
510ca126
AW
1366 NEXT (offset);
1367 }
1368
1369 /* br-if-true test:24 invert:1 _:7 offset:24
1370 *
1371 * If the value in TEST is true for the purposes of Scheme, add
1372 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1373 */
b3ae2b50 1374 VM_DEFINE_OP (31, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1375 {
1376 BR_UNARY (x, scm_is_true (x));
1377 }
1378
1379 /* br-if-null test:24 invert:1 _:7 offset:24
1380 *
1381 * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
1382 * signed 24-bit number, to the current instruction pointer.
1383 */
b3ae2b50 1384 VM_DEFINE_OP (32, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1385 {
1386 BR_UNARY (x, scm_is_null (x));
1387 }
1388
1389 /* br-if-nil test:24 invert:1 _:7 offset:24
1390 *
1391 * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
1392 * number, to the current instruction pointer.
1393 */
b3ae2b50 1394 VM_DEFINE_OP (33, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1395 {
1396 BR_UNARY (x, scm_is_lisp_false (x));
1397 }
1398
1399 /* br-if-pair test:24 invert:1 _:7 offset:24
1400 *
1401 * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
1402 * to the current instruction pointer.
1403 */
b3ae2b50 1404 VM_DEFINE_OP (34, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1405 {
1406 BR_UNARY (x, scm_is_pair (x));
1407 }
1408
1409 /* br-if-struct test:24 invert:1 _:7 offset:24
1410 *
1411 * If the value in TEST is a struct, add OFFSET, a signed 24-bit
1412 * number, to the current instruction pointer.
1413 */
b3ae2b50 1414 VM_DEFINE_OP (35, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1415 {
1416 BR_UNARY (x, SCM_STRUCTP (x));
1417 }
1418
1419 /* br-if-char test:24 invert:1 _:7 offset:24
1420 *
1421 * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
1422 * to the current instruction pointer.
1423 */
b3ae2b50 1424 VM_DEFINE_OP (36, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1425 {
1426 BR_UNARY (x, SCM_CHARP (x));
1427 }
1428
1429 /* br-if-tc7 test:24 invert:1 tc7:7 offset:24
1430 *
1431 * If the value in TEST has the TC7 given in the second word, add
1432 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1433 */
b3ae2b50 1434 VM_DEFINE_OP (37, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
510ca126
AW
1435 {
1436 BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
1437 }
1438
1439 /* br-if-eq a:12 b:12 invert:1 _:7 offset:24
1440 *
1441 * If the value in A is eq? to the value in B, add OFFSET, a signed
1442 * 24-bit number, to the current instruction pointer.
1443 */
b3ae2b50 1444 VM_DEFINE_OP (38, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1445 {
1446 BR_BINARY (x, y, scm_is_eq (x, y));
1447 }
1448
1449 /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24
1450 *
1451 * If the value in A is eqv? to the value in B, add OFFSET, a signed
1452 * 24-bit number, to the current instruction pointer.
1453 */
b3ae2b50 1454 VM_DEFINE_OP (39, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1455 {
1456 BR_BINARY (x, y,
1457 scm_is_eq (x, y)
1458 || (SCM_NIMP (x) && SCM_NIMP (y)
1459 && scm_is_true (scm_eqv_p (x, y))));
1460 }
1461
af95414f 1462 // FIXME: remove, have compiler inline eqv test instead
510ca126
AW
1463 /* br-if-equal a:12 b:12 invert:1 _:7 offset:24
1464 *
1465 * If the value in A is equal? to the value in B, add OFFSET, a signed
1466 * 24-bit number, to the current instruction pointer.
1467 */
4a1ce016
AW
1468 // FIXME: Should sync_ip before calling out and cache_fp before coming
1469 // back! Another reason to remove this opcode!
b3ae2b50 1470 VM_DEFINE_OP (40, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1471 {
1472 BR_BINARY (x, y,
1473 scm_is_eq (x, y)
1474 || (SCM_NIMP (x) && SCM_NIMP (y)
1475 && scm_is_true (scm_equal_p (x, y))));
1476 }
1477
af95414f 1478 /* br-if-= a:12 b:12 invert:1 _:7 offset:24
510ca126
AW
1479 *
1480 * If the value in A is = to the value in B, add OFFSET, a signed
1481 * 24-bit number, to the current instruction pointer.
1482 */
b3ae2b50 1483 VM_DEFINE_OP (41, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1484 {
1485 BR_ARITHMETIC (==, scm_num_eq_p);
1486 }
1487
02f9d496 1488 /* br-if-< a:12 b:12 invert:1 _:7 offset:24
510ca126
AW
1489 *
1490 * If the value in A is < to the value in B, add OFFSET, a signed
1491 * 24-bit number, to the current instruction pointer.
1492 */
b3ae2b50 1493 VM_DEFINE_OP (42, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1494 {
1495 BR_ARITHMETIC (<, scm_less_p);
1496 }
1497
02f9d496 1498 /* br-if-<= a:12 b:12 invert:1 _:7 offset:24
510ca126
AW
1499 *
1500 * If the value in A is <= to the value in B, add OFFSET, a signed
1501 * 24-bit number, to the current instruction pointer.
1502 */
b3ae2b50 1503 VM_DEFINE_OP (43, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1504 {
1505 BR_ARITHMETIC (<=, scm_leq_p);
1506 }
1507
510ca126
AW
1508
1509 \f
1510
1511 /*
1512 * Lexical binding instructions
1513 */
1514
1515 /* mov dst:12 src:12
1516 *
1517 * Copy a value from one local slot to another.
1518 */
b3ae2b50 1519 VM_DEFINE_OP (44, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
1520 {
1521 scm_t_uint16 dst;
1522 scm_t_uint16 src;
1523
20b1b913 1524 UNPACK_12_12 (op, dst, src);
510ca126
AW
1525 LOCAL_SET (dst, LOCAL_REF (src));
1526
1527 NEXT (1);
1528 }
1529
1530 /* long-mov dst:24 _:8 src:24
1531 *
1532 * Copy a value from one local slot to another.
1533 */
b3ae2b50 1534 VM_DEFINE_OP (45, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
510ca126
AW
1535 {
1536 scm_t_uint32 dst;
1537 scm_t_uint32 src;
1538
20b1b913
AW
1539 UNPACK_24 (op, dst);
1540 UNPACK_24 (ip[1], src);
510ca126
AW
1541 LOCAL_SET (dst, LOCAL_REF (src));
1542
1543 NEXT (2);
1544 }
1545
1546 /* box dst:12 src:12
1547 *
1548 * Create a new variable holding SRC, and place it in DST.
1549 */
b3ae2b50 1550 VM_DEFINE_OP (46, box, "box", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
1551 {
1552 scm_t_uint16 dst, src;
20b1b913 1553 UNPACK_12_12 (op, dst, src);
12432c86 1554 LOCAL_SET (dst, scm_cell (scm_tc7_variable, SCM_UNPACK (LOCAL_REF (src))));
510ca126
AW
1555 NEXT (1);
1556 }
1557
510ca126
AW
1558 /* box-ref dst:12 src:12
1559 *
1560 * Unpack the variable at SRC into DST, asserting that the variable is
1561 * actually bound.
1562 */
b3ae2b50 1563 VM_DEFINE_OP (47, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
1564 {
1565 scm_t_uint16 dst, src;
1566 SCM var;
20b1b913 1567 UNPACK_12_12 (op, dst, src);
510ca126 1568 var = LOCAL_REF (src);
4f406fea
AW
1569 VM_ASSERT (SCM_VARIABLEP (var),
1570 vm_error_not_a_variable ("variable-ref", var));
73fc4e73 1571 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var));
510ca126
AW
1572 LOCAL_SET (dst, VARIABLE_REF (var));
1573 NEXT (1);
1574 }
1575
1576 /* box-set! dst:12 src:12
1577 *
1578 * Set the contents of the variable at DST to SET.
1579 */
b3ae2b50 1580 VM_DEFINE_OP (48, box_set, "box-set!", OP1 (U8_U12_U12))
510ca126
AW
1581 {
1582 scm_t_uint16 dst, src;
1583 SCM var;
20b1b913 1584 UNPACK_12_12 (op, dst, src);
510ca126 1585 var = LOCAL_REF (dst);
4f406fea
AW
1586 VM_ASSERT (SCM_VARIABLEP (var),
1587 vm_error_not_a_variable ("variable-set!", var));
510ca126
AW
1588 VARIABLE_SET (var, LOCAL_REF (src));
1589 NEXT (1);
1590 }
1591
7396d216 1592 /* make-closure dst:24 offset:32 _:8 nfree:24
510ca126
AW
1593 *
1594 * Make a new closure, and write it to DST. The code for the closure
1595 * will be found at OFFSET words from the current IP. OFFSET is a
7396d216
AW
1596 * signed 32-bit integer. Space for NFREE free variables will be
1597 * allocated.
510ca126 1598 */
b3ae2b50 1599 VM_DEFINE_OP (49, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
510ca126
AW
1600 {
1601 scm_t_uint32 dst, nfree, n;
1602 scm_t_int32 offset;
1603 SCM closure;
1604
20b1b913 1605 UNPACK_24 (op, dst);
510ca126 1606 offset = ip[1];
20b1b913 1607 UNPACK_24 (ip[2], nfree);
510ca126
AW
1608
1609 // FIXME: Assert range of nfree?
12432c86 1610 closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
510ca126 1611 SCM_SET_CELL_WORD_1 (closure, ip + offset);
7396d216 1612 // FIXME: Elide these initializations?
510ca126 1613 for (n = 0; n < nfree; n++)
d798a895 1614 SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
510ca126 1615 LOCAL_SET (dst, closure);
7396d216 1616 NEXT (3);
510ca126
AW
1617 }
1618
7396d216 1619 /* free-ref dst:12 src:12 _:8 idx:24
510ca126 1620 *
7396d216 1621 * Load free variable IDX from the closure SRC into local slot DST.
510ca126 1622 */
b3ae2b50 1623 VM_DEFINE_OP (50, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
510ca126 1624 {
7396d216
AW
1625 scm_t_uint16 dst, src;
1626 scm_t_uint32 idx;
20b1b913
AW
1627 UNPACK_12_12 (op, dst, src);
1628 UNPACK_24 (ip[1], idx);
7396d216 1629 /* CHECK_FREE_VARIABLE (src); */
d798a895 1630 LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
7396d216
AW
1631 NEXT (2);
1632 }
510ca126 1633
02f9d496 1634 /* free-set! dst:12 src:12 _:8 idx:24
7396d216
AW
1635 *
1636 * Set free variable IDX from the closure DST to SRC.
1637 */
b3ae2b50 1638 VM_DEFINE_OP (51, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
7396d216
AW
1639 {
1640 scm_t_uint16 dst, src;
1641 scm_t_uint32 idx;
20b1b913
AW
1642 UNPACK_12_12 (op, dst, src);
1643 UNPACK_24 (ip[1], idx);
7396d216 1644 /* CHECK_FREE_VARIABLE (src); */
d798a895 1645 SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
7396d216 1646 NEXT (2);
510ca126
AW
1647 }
1648
1649
1650 \f
1651
1652 /*
1653 * Immediates and statically allocated non-immediates
1654 */
1655
1656 /* make-short-immediate dst:8 low-bits:16
1657 *
1658 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1659 * 0.
1660 */
b3ae2b50 1661 VM_DEFINE_OP (52, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
510ca126
AW
1662 {
1663 scm_t_uint8 dst;
1664 scm_t_bits val;
1665
20b1b913 1666 UNPACK_8_16 (op, dst, val);
510ca126
AW
1667 LOCAL_SET (dst, SCM_PACK (val));
1668 NEXT (1);
1669 }
1670
1671 /* make-long-immediate dst:24 low-bits:32
1672 *
1673 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1674 * 0.
1675 */
b7ee9e08 1676 VM_DEFINE_OP (53, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32) | OP_DST)
510ca126 1677 {
da60ba80 1678 scm_t_uint32 dst;
510ca126
AW
1679 scm_t_bits val;
1680
20b1b913 1681 UNPACK_24 (op, dst);
510ca126
AW
1682 val = ip[1];
1683 LOCAL_SET (dst, SCM_PACK (val));
1684 NEXT (2);
1685 }
1686
1687 /* make-long-long-immediate dst:24 high-bits:32 low-bits:32
1688 *
1689 * Make an immediate with HIGH-BITS and LOW-BITS.
1690 */
b3ae2b50 1691 VM_DEFINE_OP (54, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
510ca126 1692 {
da60ba80 1693 scm_t_uint32 dst;
510ca126
AW
1694 scm_t_bits val;
1695
20b1b913 1696 UNPACK_24 (op, dst);
510ca126
AW
1697#if SIZEOF_SCM_T_BITS > 4
1698 val = ip[1];
1699 val <<= 32;
1700 val |= ip[2];
1701#else
1702 ASSERT (ip[1] == 0);
1703 val = ip[2];
1704#endif
1705 LOCAL_SET (dst, SCM_PACK (val));
1706 NEXT (3);
1707 }
1708
1709 /* make-non-immediate dst:24 offset:32
1710 *
1711 * Load a pointer to statically allocated memory into DST. The
1712 * object's memory is will be found OFFSET 32-bit words away from the
1713 * current instruction pointer. OFFSET is a signed value. The
1714 * intention here is that the compiler would produce an object file
1715 * containing the words of a non-immediate object, and this
1716 * instruction creates a pointer to that memory, effectively
1717 * resurrecting that object.
1718 *
1719 * Whether the object is mutable or immutable depends on where it was
1720 * allocated by the compiler, and loaded by the loader.
1721 */
b3ae2b50 1722 VM_DEFINE_OP (55, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
510ca126
AW
1723 {
1724 scm_t_uint32 dst;
1725 scm_t_int32 offset;
1726 scm_t_uint32* loc;
1727 scm_t_bits unpacked;
1728
20b1b913 1729 UNPACK_24 (op, dst);
510ca126
AW
1730 offset = ip[1];
1731 loc = ip + offset;
1732 unpacked = (scm_t_bits) loc;
1733
1734 VM_ASSERT (!(unpacked & 0x7), abort());
1735
1736 LOCAL_SET (dst, SCM_PACK (unpacked));
1737
1738 NEXT (2);
1739 }
1740
1741 /* static-ref dst:24 offset:32
1742 *
1743 * Load a SCM value into DST. The SCM value will be fetched from
1744 * memory, OFFSET 32-bit words away from the current instruction
1745 * pointer. OFFSET is a signed value.
1746 *
1747 * The intention is for this instruction to be used to load constants
1748 * that the compiler is unable to statically allocate, like symbols.
1749 * These values would be initialized when the object file loads.
1750 */
b7ee9e08 1751 VM_DEFINE_OP (56, static_ref, "static-ref", OP2 (U8_U24, S32) | OP_DST)
510ca126
AW
1752 {
1753 scm_t_uint32 dst;
1754 scm_t_int32 offset;
1755 scm_t_uint32* loc;
1756 scm_t_uintptr loc_bits;
1757
20b1b913 1758 UNPACK_24 (op, dst);
510ca126
AW
1759 offset = ip[1];
1760 loc = ip + offset;
1761 loc_bits = (scm_t_uintptr) loc;
1762 VM_ASSERT (ALIGNED_P (loc, SCM), abort());
1763
1764 LOCAL_SET (dst, *((SCM *) loc_bits));
1765
1766 NEXT (2);
1767 }
1768
1769 /* static-set! src:24 offset:32
1770 *
1771 * Store a SCM value into memory, OFFSET 32-bit words away from the
1772 * current instruction pointer. OFFSET is a signed value.
1773 */
b3ae2b50 1774 VM_DEFINE_OP (57, static_set, "static-set!", OP2 (U8_U24, LO32))
510ca126
AW
1775 {
1776 scm_t_uint32 src;
1777 scm_t_int32 offset;
1778 scm_t_uint32* loc;
1779
20b1b913 1780 UNPACK_24 (op, src);
510ca126
AW
1781 offset = ip[1];
1782 loc = ip + offset;
1783 VM_ASSERT (ALIGNED_P (loc, SCM), abort());
1784
1785 *((SCM *) loc) = LOCAL_REF (src);
1786
1787 NEXT (2);
1788 }
1789
2ab2a10d 1790 /* static-patch! _:24 dst-offset:32 src-offset:32
510ca126 1791 *
2ab2a10d
AW
1792 * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
1793 * are signed 32-bit values, indicating a memory address as a number
1794 * of 32-bit words away from the current instruction pointer.
510ca126 1795 */
b3ae2b50 1796 VM_DEFINE_OP (58, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32))
510ca126 1797 {
2ab2a10d
AW
1798 scm_t_int32 dst_offset, src_offset;
1799 void *src;
1800 void** dst_loc;
510ca126 1801
2ab2a10d
AW
1802 dst_offset = ip[1];
1803 src_offset = ip[2];
510ca126 1804
2ab2a10d
AW
1805 dst_loc = (void **) (ip + dst_offset);
1806 src = ip + src_offset;
1807 VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
510ca126 1808
2ab2a10d
AW
1809 *dst_loc = src;
1810
1811 NEXT (3);
510ca126
AW
1812 }
1813
1814 \f
1815
1816 /*
1817 * Mutable top-level bindings
1818 */
1819
1820 /* There are three slightly different ways to resolve toplevel
1821 variables.
1822
1823 1. A toplevel reference outside of a function. These need to be
1824 looked up when the expression is evaluated -- no later, and no
1825 before. They are looked up relative to the module that is
1826 current when the expression is evaluated. For example:
1827
1828 (if (foo) a b)
1829
1830 The "resolve" instruction resolves the variable (box), and then
1831 access is via box-ref or box-set!.
1832
1833 2. A toplevel reference inside a function. These are looked up
1834 relative to the module that was current when the function was
1835 defined. Unlike code at the toplevel, which is usually run only
1836 once, these bindings benefit from memoized lookup, in which the
1837 variable resulting from the lookup is cached in the function.
1838
1839 (lambda () (if (foo) a b))
1840
af95414f
AW
1841 The toplevel-box instruction is equivalent to "resolve", but
1842 caches the resulting variable in statically allocated memory.
510ca126
AW
1843
1844 3. A reference to an identifier with respect to a particular
1845 module. This can happen for primitive references, and
af95414f
AW
1846 references residualized by macro expansions. These can always
1847 be cached. Use module-box for these.
510ca126
AW
1848 */
1849
1850 /* current-module dst:24
1851 *
1852 * Store the current module in DST.
1853 */
b3ae2b50 1854 VM_DEFINE_OP (59, current_module, "current-module", OP1 (U8_U24) | OP_DST)
510ca126
AW
1855 {
1856 scm_t_uint32 dst;
1857
20b1b913 1858 UNPACK_24 (op, dst);
510ca126
AW
1859
1860 SYNC_IP ();
1861 LOCAL_SET (dst, scm_current_module ());
1862
1863 NEXT (1);
1864 }
1865
af95414f 1866 /* resolve dst:24 bound?:1 _:7 sym:24
510ca126 1867 *
af95414f
AW
1868 * Resolve SYM in the current module, and place the resulting variable
1869 * in DST.
510ca126 1870 */
b3ae2b50 1871 VM_DEFINE_OP (60, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
510ca126 1872 {
af95414f
AW
1873 scm_t_uint32 dst;
1874 scm_t_uint32 sym;
1875 SCM var;
510ca126 1876
20b1b913
AW
1877 UNPACK_24 (op, dst);
1878 UNPACK_24 (ip[1], sym);
510ca126
AW
1879
1880 SYNC_IP ();
af95414f 1881 var = scm_lookup (LOCAL_REF (sym));
4a1ce016 1882 CACHE_FP ();
af95414f 1883 if (ip[1] & 0x1)
73fc4e73 1884 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (LOCAL_REF (sym)));
af95414f 1885 LOCAL_SET (dst, var);
510ca126 1886
af95414f 1887 NEXT (2);
510ca126
AW
1888 }
1889
6165d812 1890 /* define! sym:12 val:12
510ca126
AW
1891 *
1892 * Look up a binding for SYM in the current module, creating it if
1893 * necessary. Set its value to VAL.
1894 */
b3ae2b50 1895 VM_DEFINE_OP (61, define, "define!", OP1 (U8_U12_U12))
510ca126
AW
1896 {
1897 scm_t_uint16 sym, val;
20b1b913 1898 UNPACK_12_12 (op, sym, val);
510ca126
AW
1899 SYNC_IP ();
1900 scm_define (LOCAL_REF (sym), LOCAL_REF (val));
4a1ce016 1901 CACHE_FP ();
510ca126
AW
1902 NEXT (1);
1903 }
1904
af95414f 1905 /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
510ca126
AW
1906 *
1907 * Load a SCM value. The SCM value will be fetched from memory,
1908 * VAR-OFFSET 32-bit words away from the current instruction pointer.
af95414f 1909 * VAR-OFFSET is a signed value. Up to here, toplevel-box is like
510ca126
AW
1910 * static-ref.
1911 *
af95414f
AW
1912 * Then, if the loaded value is a variable, it is placed in DST, and control
1913 * flow continues.
510ca126
AW
1914 *
1915 * Otherwise, we have to resolve the variable. In that case we load
1916 * the module from MOD-OFFSET, just as we loaded the variable.
1917 * Usually the module gets set when the closure is created. The name
1918 * is an offset to a symbol.
1919 *
af95414f
AW
1920 * We use the module and the symbol to resolve the variable, placing it in
1921 * DST, and caching the resolved variable so that we will hit the cache next
1922 * time.
510ca126 1923 */
b3ae2b50 1924 VM_DEFINE_OP (62, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
510ca126
AW
1925 {
1926 scm_t_uint32 dst;
1927 scm_t_int32 var_offset;
1928 scm_t_uint32* var_loc_u32;
1929 SCM *var_loc;
1930 SCM var;
1931
20b1b913 1932 UNPACK_24 (op, dst);
510ca126
AW
1933 var_offset = ip[1];
1934 var_loc_u32 = ip + var_offset;
1935 VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
1936 var_loc = (SCM *) var_loc_u32;
1937 var = *var_loc;
1938
1939 if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
1940 {
1941 SCM mod, sym;
1942 scm_t_int32 mod_offset = ip[2]; /* signed */
1943 scm_t_int32 sym_offset = ip[3]; /* signed */
1944 scm_t_uint32 *mod_loc = ip + mod_offset;
1945 scm_t_uint32 *sym_loc = ip + sym_offset;
1946
1947 SYNC_IP ();
1948
1949 VM_ASSERT (ALIGNED_P (mod_loc, SCM), abort());
1950 VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
1951
1952 mod = *((SCM *) mod_loc);
1953 sym = *((SCM *) sym_loc);
1954
e23f9e44
AW
1955 /* If the toplevel scope was captured before modules were
1956 booted, use the root module. */
1957 if (scm_is_false (mod))
1958 mod = scm_the_root_module ();
1959
510ca126 1960 var = scm_module_lookup (mod, sym);
4a1ce016 1961 CACHE_FP ();
af95414f 1962 if (ip[4] & 0x1)
73fc4e73 1963 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
510ca126
AW
1964
1965 *var_loc = var;
1966 }
1967
af95414f
AW
1968 LOCAL_SET (dst, var);
1969 NEXT (5);
510ca126
AW
1970 }
1971
af95414f 1972 /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
510ca126 1973 *
af95414f 1974 * Like toplevel-box, except MOD-OFFSET points at the name of a module
510ca126
AW
1975 * instead of the module itself.
1976 */
b3ae2b50 1977 VM_DEFINE_OP (63, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
510ca126
AW
1978 {
1979 scm_t_uint32 dst;
1980 scm_t_int32 var_offset;
1981 scm_t_uint32* var_loc_u32;
1982 SCM *var_loc;
1983 SCM var;
1984
20b1b913 1985 UNPACK_24 (op, dst);
510ca126
AW
1986 var_offset = ip[1];
1987 var_loc_u32 = ip + var_offset;
1988 VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
1989 var_loc = (SCM *) var_loc_u32;
1990 var = *var_loc;
1991
1992 if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
1993 {
1994 SCM modname, sym;
1995 scm_t_int32 modname_offset = ip[2]; /* signed */
1996 scm_t_int32 sym_offset = ip[3]; /* signed */
1997 scm_t_uint32 *modname_words = ip + modname_offset;
1998 scm_t_uint32 *sym_loc = ip + sym_offset;
1999
2000 SYNC_IP ();
2001
2002 VM_ASSERT (!(((scm_t_uintptr) modname_words) & 0x7), abort());
2003 VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
2004
2005 modname = SCM_PACK ((scm_t_bits) modname_words);
2006 sym = *((SCM *) sym_loc);
2007
e23f9e44
AW
2008 if (!scm_module_system_booted_p)
2009 {
698c55b0
AW
2010 ASSERT (scm_is_true
2011 scm_equal_p (modname,
2012 scm_list_2
2013 (SCM_BOOL_T,
2014 scm_from_utf8_symbol ("guile"))));
e23f9e44
AW
2015 var = scm_lookup (sym);
2016 }
2017 else if (scm_is_true (SCM_CAR (modname)))
510ca126
AW
2018 var = scm_public_lookup (SCM_CDR (modname), sym);
2019 else
2020 var = scm_private_lookup (SCM_CDR (modname), sym);
2021
4a1ce016
AW
2022 CACHE_FP ();
2023
af95414f 2024 if (ip[4] & 0x1)
73fc4e73 2025 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
510ca126
AW
2026
2027 *var_loc = var;
2028 }
2029
af95414f
AW
2030 LOCAL_SET (dst, var);
2031 NEXT (5);
510ca126
AW
2032 }
2033
2034 \f
2035
2036 /*
2037 * The dynamic environment
2038 */
2039
8d59d55e 2040 /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
510ca126
AW
2041 *
2042 * Push a new prompt on the dynamic stack, with a tag from TAG and a
2043 * handler at HANDLER-OFFSET words from the current IP. The handler
8d59d55e
AW
2044 * will expect a multiple-value return as if from a call with the
2045 * procedure at PROC-SLOT.
510ca126 2046 */
b3ae2b50 2047 VM_DEFINE_OP (64, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
510ca126 2048 {
8d59d55e 2049 scm_t_uint32 tag, proc_slot;
510ca126
AW
2050 scm_t_int32 offset;
2051 scm_t_uint8 escape_only_p;
2052 scm_t_dynstack_prompt_flags flags;
2053
20b1b913 2054 UNPACK_24 (op, tag);
8d59d55e 2055 escape_only_p = ip[1] & 0x1;
20b1b913 2056 UNPACK_24 (ip[1], proc_slot);
8d59d55e 2057 offset = ip[2];
510ca126
AW
2058 offset >>= 8; /* Sign extension */
2059
2060 /* Push the prompt onto the dynamic stack. */
2061 flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
12432c86 2062 scm_dynstack_push_prompt (&current_thread->dynstack, flags,
510ca126 2063 LOCAL_REF (tag),
0bca90aa
AW
2064 fp - vp->stack_base,
2065 LOCAL_ADDRESS (proc_slot) - vp->stack_base,
9121d9f1 2066 ip + offset,
dd1c7dec 2067 registers);
8d59d55e 2068 NEXT (3);
510ca126 2069 }
510ca126
AW
2070
2071 /* wind winder:12 unwinder:12
2072 *
2073 * Push wind and unwind procedures onto the dynamic stack. Note that
2074 * neither are actually called; the compiler should emit calls to wind
2075 * and unwind for the normal dynamic-wind control flow. Also note that
2076 * the compiler should have inserted checks that they wind and unwind
2077 * procs are thunks, if it could not prove that to be the case.
2078 */
b3ae2b50 2079 VM_DEFINE_OP (65, wind, "wind", OP1 (U8_U12_U12))
510ca126
AW
2080 {
2081 scm_t_uint16 winder, unwinder;
20b1b913 2082 UNPACK_12_12 (op, winder, unwinder);
12432c86 2083 scm_dynstack_push_dynwind (&current_thread->dynstack,
510ca126
AW
2084 LOCAL_REF (winder), LOCAL_REF (unwinder));
2085 NEXT (1);
2086 }
2087
510ca126
AW
2088 /* unwind _:24
2089 *
2090 * A normal exit from the dynamic extent of an expression. Pop the top
2091 * entry off of the dynamic stack.
2092 */
b3ae2b50 2093 VM_DEFINE_OP (66, unwind, "unwind", OP1 (U8_X24))
510ca126 2094 {
12432c86 2095 scm_dynstack_pop (&current_thread->dynstack);
510ca126
AW
2096 NEXT (1);
2097 }
2098
98eaef1b 2099 /* push-fluid fluid:12 value:12
510ca126 2100 *
ddf0d7bb 2101 * Dynamically bind VALUE to FLUID.
510ca126 2102 */
b3ae2b50 2103 VM_DEFINE_OP (67, push_fluid, "push-fluid", OP1 (U8_U12_U12))
510ca126 2104 {
98eaef1b 2105 scm_t_uint32 fluid, value;
510ca126 2106
20b1b913 2107 UNPACK_12_12 (op, fluid, value);
510ca126 2108
12432c86 2109 scm_dynstack_push_fluid (&current_thread->dynstack,
2a4ee2ac 2110 LOCAL_REF (fluid), LOCAL_REF (value),
12432c86 2111 current_thread->dynamic_state);
98eaef1b 2112 NEXT (1);
510ca126 2113 }
510ca126 2114
98eaef1b 2115 /* pop-fluid _:24
510ca126 2116 *
ddf0d7bb
AW
2117 * Leave the dynamic extent of a with-fluid* expression, restoring the
2118 * fluid to its previous value.
510ca126 2119 */
b3ae2b50 2120 VM_DEFINE_OP (68, pop_fluid, "pop-fluid", OP1 (U8_X24))
510ca126
AW
2121 {
2122 /* This function must not allocate. */
12432c86
RT
2123 scm_dynstack_unwind_fluid (&current_thread->dynstack,
2124 current_thread->dynamic_state);
510ca126
AW
2125 NEXT (1);
2126 }
2127
2128 /* fluid-ref dst:12 src:12
2129 *
2130 * Reference the fluid in SRC, and place the value in DST.
2131 */
b3ae2b50 2132 VM_DEFINE_OP (69, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2133 {
2134 scm_t_uint16 dst, src;
2135 size_t num;
2136 SCM fluid, fluids;
2137
20b1b913 2138 UNPACK_12_12 (op, dst, src);
510ca126 2139 fluid = LOCAL_REF (src);
12432c86 2140 fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
510ca126
AW
2141 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
2142 || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
2143 {
2144 /* Punt dynstate expansion and error handling to the C proc. */
2145 SYNC_IP ();
2146 LOCAL_SET (dst, scm_fluid_ref (fluid));
2147 }
2148 else
2149 {
2150 SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
2151 if (scm_is_eq (val, SCM_UNDEFINED))
2152 val = SCM_I_FLUID_DEFAULT (fluid);
2153 VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
73fc4e73 2154 vm_error_unbound_fluid (fluid));
510ca126
AW
2155 LOCAL_SET (dst, val);
2156 }
2157
2158 NEXT (1);
2159 }
2160
2161 /* fluid-set fluid:12 val:12
2162 *
2163 * Set the value of the fluid in DST to the value in SRC.
2164 */
b3ae2b50 2165 VM_DEFINE_OP (70, fluid_set, "fluid-set", OP1 (U8_U12_U12))
510ca126
AW
2166 {
2167 scm_t_uint16 a, b;
2168 size_t num;
2169 SCM fluid, fluids;
2170
20b1b913 2171 UNPACK_12_12 (op, a, b);
510ca126 2172 fluid = LOCAL_REF (a);
12432c86 2173 fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
510ca126
AW
2174 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
2175 || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
2176 {
2177 /* Punt dynstate expansion and error handling to the C proc. */
2178 SYNC_IP ();
2179 scm_fluid_set_x (fluid, LOCAL_REF (b));
2180 }
2181 else
2182 SCM_SIMPLE_VECTOR_SET (fluids, num, LOCAL_REF (b));
2183
2184 NEXT (1);
2185 }
2186
2187
2188 \f
2189
2190 /*
2191 * Strings, symbols, and keywords
2192 */
2193
2194 /* string-length dst:12 src:12
2195 *
2196 * Store the length of the string in SRC in DST.
2197 */
b3ae2b50 2198 VM_DEFINE_OP (71, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2199 {
2200 ARGS1 (str);
2201 if (SCM_LIKELY (scm_is_string (str)))
2202 RETURN (SCM_I_MAKINUM (scm_i_string_length (str)));
2203 else
2204 {
2205 SYNC_IP ();
2206 RETURN (scm_string_length (str));
2207 }
2208 }
2209
2210 /* string-ref dst:8 src:8 idx:8
2211 *
2212 * Fetch the character at position IDX in the string in SRC, and store
2213 * it in DST.
2214 */
b3ae2b50 2215 VM_DEFINE_OP (72, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2216 {
2217 scm_t_signed_bits i = 0;
2218 ARGS2 (str, idx);
2219 if (SCM_LIKELY (scm_is_string (str)
2220 && SCM_I_INUMP (idx)
2221 && ((i = SCM_I_INUM (idx)) >= 0)
2222 && i < scm_i_string_length (str)))
2223 RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, i)));
2224 else
2225 {
2226 SYNC_IP ();
2227 RETURN (scm_string_ref (str, idx));
2228 }
2229 }
2230
2231 /* No string-set! instruction, as there is no good fast path there. */
2232
ddf0d7bb 2233 /* string->number dst:12 src:12
510ca126
AW
2234 *
2235 * Parse a string in SRC to a number, and store in DST.
2236 */
b3ae2b50 2237 VM_DEFINE_OP (73, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2238 {
2239 scm_t_uint16 dst, src;
2240
20b1b913 2241 UNPACK_12_12 (op, dst, src);
510ca126
AW
2242 SYNC_IP ();
2243 LOCAL_SET (dst,
2244 scm_string_to_number (LOCAL_REF (src),
2245 SCM_UNDEFINED /* radix = 10 */));
2246 NEXT (1);
2247 }
2248
ddf0d7bb 2249 /* string->symbol dst:12 src:12
510ca126
AW
2250 *
2251 * Parse a string in SRC to a symbol, and store in DST.
2252 */
b3ae2b50 2253 VM_DEFINE_OP (74, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2254 {
2255 scm_t_uint16 dst, src;
2256
20b1b913 2257 UNPACK_12_12 (op, dst, src);
510ca126
AW
2258 SYNC_IP ();
2259 LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src)));
2260 NEXT (1);
2261 }
2262
2263 /* symbol->keyword dst:12 src:12
2264 *
2265 * Make a keyword from the symbol in SRC, and store it in DST.
2266 */
b3ae2b50 2267 VM_DEFINE_OP (75, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2268 {
2269 scm_t_uint16 dst, src;
20b1b913 2270 UNPACK_12_12 (op, dst, src);
510ca126
AW
2271 SYNC_IP ();
2272 LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
2273 NEXT (1);
2274 }
2275
2276 \f
2277
2278 /*
2279 * Pairs
2280 */
2281
2282 /* cons dst:8 car:8 cdr:8
2283 *
2284 * Cons CAR and CDR, and store the result in DST.
2285 */
b3ae2b50 2286 VM_DEFINE_OP (76, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2287 {
2288 ARGS2 (x, y);
12432c86 2289 RETURN (scm_cons (x, y));
510ca126
AW
2290 }
2291
2292 /* car dst:12 src:12
2293 *
2294 * Place the car of SRC in DST.
2295 */
b3ae2b50 2296 VM_DEFINE_OP (77, car, "car", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2297 {
2298 ARGS1 (x);
2299 VM_VALIDATE_PAIR (x, "car");
2300 RETURN (SCM_CAR (x));
2301 }
2302
2303 /* cdr dst:12 src:12
2304 *
2305 * Place the cdr of SRC in DST.
2306 */
b3ae2b50 2307 VM_DEFINE_OP (78, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2308 {
2309 ARGS1 (x);
2310 VM_VALIDATE_PAIR (x, "cdr");
2311 RETURN (SCM_CDR (x));
2312 }
2313
2314 /* set-car! pair:12 car:12
2315 *
2316 * Set the car of DST to SRC.
2317 */
b3ae2b50 2318 VM_DEFINE_OP (79, set_car, "set-car!", OP1 (U8_U12_U12))
510ca126
AW
2319 {
2320 scm_t_uint16 a, b;
2321 SCM x, y;
20b1b913 2322 UNPACK_12_12 (op, a, b);
510ca126
AW
2323 x = LOCAL_REF (a);
2324 y = LOCAL_REF (b);
2325 VM_VALIDATE_PAIR (x, "set-car!");
2326 SCM_SETCAR (x, y);
2327 NEXT (1);
2328 }
2329
2330 /* set-cdr! pair:12 cdr:12
2331 *
2332 * Set the cdr of DST to SRC.
2333 */
b3ae2b50 2334 VM_DEFINE_OP (80, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
510ca126
AW
2335 {
2336 scm_t_uint16 a, b;
2337 SCM x, y;
20b1b913 2338 UNPACK_12_12 (op, a, b);
510ca126
AW
2339 x = LOCAL_REF (a);
2340 y = LOCAL_REF (b);
2341 VM_VALIDATE_PAIR (x, "set-car!");
2342 SCM_SETCDR (x, y);
2343 NEXT (1);
2344 }
2345
2346
2347 \f
2348
2349 /*
2350 * Numeric operations
2351 */
2352
2353 /* add dst:8 a:8 b:8
2354 *
2355 * Add A to B, and place the result in DST.
2356 */
b3ae2b50 2357 VM_DEFINE_OP (81, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2358 {
2359 BINARY_INTEGER_OP (+, scm_sum);
2360 }
2361
2362 /* add1 dst:12 src:12
2363 *
2364 * Add 1 to the value in SRC, and place the result in DST.
2365 */
b3ae2b50 2366 VM_DEFINE_OP (82, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2367 {
2368 ARGS1 (x);
2369
d2295ba5
MW
2370 /* Check for overflow. We must avoid overflow in the signed
2371 addition below, even if X is not an inum. */
2372 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) <= INUM_MAX - INUM_STEP))
510ca126
AW
2373 {
2374 SCM result;
2375
d2295ba5
MW
2376 /* Add 1 to the integer without untagging. */
2377 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) + INUM_STEP);
510ca126
AW
2378
2379 if (SCM_LIKELY (SCM_I_INUMP (result)))
2380 RETURN (result);
2381 }
2382
4a1ce016 2383 RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (1)));
510ca126
AW
2384 }
2385
2386 /* sub dst:8 a:8 b:8
2387 *
2388 * Subtract B from A, and place the result in DST.
2389 */
b3ae2b50 2390 VM_DEFINE_OP (83, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2391 {
2392 BINARY_INTEGER_OP (-, scm_difference);
2393 }
2394
2395 /* sub1 dst:12 src:12
2396 *
2397 * Subtract 1 from SRC, and place the result in DST.
2398 */
b3ae2b50 2399 VM_DEFINE_OP (84, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2400 {
2401 ARGS1 (x);
2402
d2295ba5
MW
2403 /* Check for overflow. We must avoid overflow in the signed
2404 subtraction below, even if X is not an inum. */
2405 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) >= INUM_MIN + INUM_STEP))
510ca126
AW
2406 {
2407 SCM result;
2408
d2295ba5
MW
2409 /* Substract 1 from the integer without untagging. */
2410 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) - INUM_STEP);
510ca126
AW
2411
2412 if (SCM_LIKELY (SCM_I_INUMP (result)))
2413 RETURN (result);
2414 }
2415
4a1ce016 2416 RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (1)));
510ca126
AW
2417 }
2418
2419 /* mul dst:8 a:8 b:8
2420 *
2421 * Multiply A and B, and place the result in DST.
2422 */
b3ae2b50 2423 VM_DEFINE_OP (85, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2424 {
2425 ARGS2 (x, y);
4a1ce016 2426 RETURN_EXP (scm_product (x, y));
510ca126
AW
2427 }
2428
2429 /* div dst:8 a:8 b:8
2430 *
2431 * Divide A by B, and place the result in DST.
2432 */
b3ae2b50 2433 VM_DEFINE_OP (86, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2434 {
2435 ARGS2 (x, y);
4a1ce016 2436 RETURN_EXP (scm_divide (x, y));
510ca126
AW
2437 }
2438
2439 /* quo dst:8 a:8 b:8
2440 *
2441 * Divide A by B, and place the quotient in DST.
2442 */
b3ae2b50 2443 VM_DEFINE_OP (87, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2444 {
2445 ARGS2 (x, y);
4a1ce016 2446 RETURN_EXP (scm_quotient (x, y));
510ca126
AW
2447 }
2448
2449 /* rem dst:8 a:8 b:8
2450 *
2451 * Divide A by B, and place the remainder in DST.
2452 */
b3ae2b50 2453 VM_DEFINE_OP (88, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2454 {
2455 ARGS2 (x, y);
4a1ce016 2456 RETURN_EXP (scm_remainder (x, y));
510ca126
AW
2457 }
2458
2459 /* mod dst:8 a:8 b:8
2460 *
2461 * Place the modulo of A by B in DST.
2462 */
b3ae2b50 2463 VM_DEFINE_OP (89, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2464 {
2465 ARGS2 (x, y);
4a1ce016 2466 RETURN_EXP (scm_modulo (x, y));
510ca126
AW
2467 }
2468
2469 /* ash dst:8 a:8 b:8
2470 *
2471 * Shift A arithmetically by B bits, and place the result in DST.
2472 */
b3ae2b50 2473 VM_DEFINE_OP (90, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2474 {
2475 ARGS2 (x, y);
2476 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2477 {
2478 if (SCM_I_INUM (y) < 0)
2479 /* Right shift, will be a fixnum. */
0bd65965
MW
2480 RETURN (SCM_I_MAKINUM
2481 (SCM_SRS (SCM_I_INUM (x),
2482 (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1)
2483 ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1)));
510ca126
AW
2484 else
2485 /* Left shift. See comments in scm_ash. */
2486 {
2487 scm_t_signed_bits nn, bits_to_shift;
2488
2489 nn = SCM_I_INUM (x);
2490 bits_to_shift = SCM_I_INUM (y);
2491
2492 if (bits_to_shift < SCM_I_FIXNUM_BIT-1
2493 && ((scm_t_bits)
2494 (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
2495 <= 1))
475772ea
MW
2496 RETURN (SCM_I_MAKINUM (nn < 0
2497 ? -(-nn << bits_to_shift)
2498 : (nn << bits_to_shift)));
510ca126
AW
2499 /* fall through */
2500 }
2501 /* fall through */
2502 }
4a1ce016 2503 RETURN_EXP (scm_ash (x, y));
510ca126
AW
2504 }
2505
2506 /* logand dst:8 a:8 b:8
2507 *
2508 * Place the bitwise AND of A and B into DST.
2509 */
b3ae2b50 2510 VM_DEFINE_OP (91, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2511 {
2512 ARGS2 (x, y);
2513 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
e7f64971
MW
2514 /* Compute bitwise AND without untagging */
2515 RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
4a1ce016 2516 RETURN_EXP (scm_logand (x, y));
510ca126
AW
2517 }
2518
2519 /* logior dst:8 a:8 b:8
2520 *
2521 * Place the bitwise inclusive OR of A with B in DST.
2522 */
b3ae2b50 2523 VM_DEFINE_OP (92, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2524 {
2525 ARGS2 (x, y);
2526 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
e7f64971
MW
2527 /* Compute bitwise OR without untagging */
2528 RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
4a1ce016 2529 RETURN_EXP (scm_logior (x, y));
510ca126
AW
2530 }
2531
2532 /* logxor dst:8 a:8 b:8
2533 *
2534 * Place the bitwise exclusive OR of A with B in DST.
2535 */
b3ae2b50 2536 VM_DEFINE_OP (93, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2537 {
2538 ARGS2 (x, y);
2539 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2540 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
4a1ce016 2541 RETURN_EXP (scm_logxor (x, y));
510ca126
AW
2542 }
2543
d38ca16e
AW
2544 /* make-vector dst:8 length:8 init:8
2545 *
2546 * Make a vector and write it to DST. The vector will have space for
2547 * LENGTH slots. They will be filled with the value in slot INIT.
2548 */
2549 VM_DEFINE_OP (94, make_vector, "make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
2550 {
2551 scm_t_uint8 dst, init, length;
2552
2553 UNPACK_8_8_8 (op, dst, length, init);
2554
2555 LOCAL_SET (dst, scm_make_vector (LOCAL_REF (length), LOCAL_REF (init)));
2556
2557 NEXT (1);
2558 }
2559
4c906ad5 2560 /* make-vector/immediate dst:8 length:8 init:8
607fe5a6
AW
2561 *
2562 * Make a short vector of known size and write it to DST. The vector
2563 * will have space for LENGTH slots, an immediate value. They will be
2564 * filled with the value in slot INIT.
2565 */
d38ca16e 2566 VM_DEFINE_OP (95, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
607fe5a6
AW
2567 {
2568 scm_t_uint8 dst, init;
2569 scm_t_int32 length, n;
2570 SCM val, vector;
2571
20b1b913 2572 UNPACK_8_8_8 (op, dst, length, init);
607fe5a6
AW
2573
2574 val = LOCAL_REF (init);
12432c86 2575 vector = scm_words (scm_tc7_vector | (length << 8), length + 1);
607fe5a6
AW
2576 for (n = 0; n < length; n++)
2577 SCM_SIMPLE_VECTOR_SET (vector, n, val);
2578 LOCAL_SET (dst, vector);
2579 NEXT (1);
2580 }
2581
510ca126
AW
2582 /* vector-length dst:12 src:12
2583 *
2584 * Store the length of the vector in SRC in DST.
2585 */
d38ca16e 2586 VM_DEFINE_OP (96, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2587 {
2588 ARGS1 (vect);
a32488ba
AW
2589 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2590 vm_error_not_a_vector ("vector-ref", vect));
2591 RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
510ca126
AW
2592 }
2593
2594 /* vector-ref dst:8 src:8 idx:8
2595 *
2596 * Fetch the item at position IDX in the vector in SRC, and store it
2597 * in DST.
2598 */
d38ca16e 2599 VM_DEFINE_OP (97, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2600 {
2601 scm_t_signed_bits i = 0;
2602 ARGS2 (vect, idx);
a32488ba
AW
2603 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2604 vm_error_not_a_vector ("vector-ref", vect));
2605 VM_ASSERT ((SCM_I_INUMP (idx)
2606 && ((i = SCM_I_INUM (idx)) >= 0)
2607 && i < SCM_I_VECTOR_LENGTH (vect)),
2608 vm_error_out_of_range ("vector-ref", idx));
2609 RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
510ca126
AW
2610 }
2611
4c906ad5 2612 /* vector-ref/immediate dst:8 src:8 idx:8
510ca126
AW
2613 *
2614 * Fill DST with the item IDX elements into the vector at SRC. Useful
2615 * for building data types using vectors.
2616 */
d38ca16e 2617 VM_DEFINE_OP (98, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2618 {
2619 scm_t_uint8 dst, src, idx;
2620 SCM v;
2621
20b1b913 2622 UNPACK_8_8_8 (op, dst, src, idx);
510ca126 2623 v = LOCAL_REF (src);
a32488ba
AW
2624 VM_ASSERT (SCM_I_IS_VECTOR (v),
2625 vm_error_not_a_vector ("vector-ref", v));
2626 VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (v),
2627 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
2628 LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
510ca126
AW
2629 NEXT (1);
2630 }
2631
2632 /* vector-set! dst:8 idx:8 src:8
2633 *
2634 * Store SRC into the vector DST at index IDX.
2635 */
d38ca16e 2636 VM_DEFINE_OP (99, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
2637 {
2638 scm_t_uint8 dst, idx_var, src;
2639 SCM vect, idx, val;
2640 scm_t_signed_bits i = 0;
2641
20b1b913 2642 UNPACK_8_8_8 (op, dst, idx_var, src);
510ca126
AW
2643 vect = LOCAL_REF (dst);
2644 idx = LOCAL_REF (idx_var);
2645 val = LOCAL_REF (src);
2646
a32488ba
AW
2647 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2648 vm_error_not_a_vector ("vector-ref", vect));
2649 VM_ASSERT ((SCM_I_INUMP (idx)
2650 && ((i = SCM_I_INUM (idx)) >= 0)
2651 && i < SCM_I_VECTOR_LENGTH (vect)),
2652 vm_error_out_of_range ("vector-ref", idx));
2653 SCM_I_VECTOR_WELTS (vect)[i] = val;
510ca126
AW
2654 NEXT (1);
2655 }
2656
4c906ad5 2657 /* vector-set!/immediate dst:8 idx:8 src:8
8ba3f20c
AW
2658 *
2659 * Store SRC into the vector DST at index IDX. Here IDX is an
2660 * immediate value.
2661 */
d38ca16e 2662 VM_DEFINE_OP (100, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
8ba3f20c
AW
2663 {
2664 scm_t_uint8 dst, idx, src;
2665 SCM vect, val;
2666
20b1b913 2667 UNPACK_8_8_8 (op, dst, idx, src);
8ba3f20c
AW
2668 vect = LOCAL_REF (dst);
2669 val = LOCAL_REF (src);
2670
a32488ba
AW
2671 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2672 vm_error_not_a_vector ("vector-ref", vect));
2673 VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
2674 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
2675 SCM_I_VECTOR_WELTS (vect)[idx] = val;
8ba3f20c
AW
2676 NEXT (1);
2677 }
2678
510ca126
AW
2679
2680 \f
2681
2682 /*
2683 * Structs and GOOPS
2684 */
2685
2686 /* struct-vtable dst:12 src:12
2687 *
2688 * Store the vtable of SRC into DST.
2689 */
d38ca16e 2690 VM_DEFINE_OP (101, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2691 {
2692 ARGS1 (obj);
2693 VM_VALIDATE_STRUCT (obj, "struct_vtable");
2694 RETURN (SCM_STRUCT_VTABLE (obj));
2695 }
2696
4c906ad5 2697 /* allocate-struct/immediate dst:8 vtable:8 nfields:8
510ca126 2698 *
14d10292
AW
2699 * Allocate a new struct with VTABLE, and place it in DST. The struct
2700 * will be constructed with space for NFIELDS fields, which should
2701 * correspond to the field count of the VTABLE.
510ca126 2702 */
d38ca16e 2703 VM_DEFINE_OP (102, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126 2704 {
14d10292
AW
2705 scm_t_uint8 dst, vtable, nfields;
2706 SCM ret;
510ca126 2707
20b1b913 2708 UNPACK_8_8_8 (op, dst, vtable, nfields);
510ca126
AW
2709
2710 SYNC_IP ();
14d10292 2711 ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields));
510ca126 2712 LOCAL_SET (dst, ret);
14d10292
AW
2713
2714 NEXT (1);
510ca126 2715 }
510ca126 2716
4c906ad5 2717 /* struct-ref/immediate dst:8 src:8 idx:8
510ca126
AW
2718 *
2719 * Fetch the item at slot IDX in the struct in SRC, and store it
4c906ad5 2720 * in DST. IDX is an immediate unsigned 8-bit value.
510ca126 2721 */
d38ca16e 2722 VM_DEFINE_OP (103, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126 2723 {
4c906ad5
AW
2724 scm_t_uint8 dst, src, idx;
2725 SCM obj;
2726
20b1b913 2727 UNPACK_8_8_8 (op, dst, src, idx);
4c906ad5
AW
2728
2729 obj = LOCAL_REF (src);
510ca126
AW
2730
2731 if (SCM_LIKELY (SCM_STRUCTP (obj)
2732 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2733 SCM_VTABLE_FLAG_SIMPLE)
4c906ad5
AW
2734 && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
2735 scm_vtable_index_size)))
2736 RETURN (SCM_STRUCT_SLOT_REF (obj, idx));
510ca126
AW
2737
2738 SYNC_IP ();
4c906ad5 2739 RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx)));
510ca126
AW
2740 }
2741
4c906ad5 2742 /* struct-set!/immediate dst:8 idx:8 src:8
510ca126 2743 *
4c906ad5
AW
2744 * Store SRC into the struct DST at slot IDX. IDX is an immediate
2745 * unsigned 8-bit value.
510ca126 2746 */
d38ca16e 2747 VM_DEFINE_OP (104, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
510ca126
AW
2748 {
2749 scm_t_uint8 dst, idx, src;
4c906ad5
AW
2750 SCM obj, val;
2751
20b1b913 2752 UNPACK_8_8_8 (op, dst, idx, src);
4c906ad5 2753
510ca126 2754 obj = LOCAL_REF (dst);
510ca126 2755 val = LOCAL_REF (src);
4c906ad5 2756
510ca126
AW
2757 if (SCM_LIKELY (SCM_STRUCTP (obj)
2758 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2759 SCM_VTABLE_FLAG_SIMPLE)
2760 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2761 SCM_VTABLE_FLAG_SIMPLE_RW)
4c906ad5
AW
2762 && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
2763 scm_vtable_index_size)))
510ca126 2764 {
4c906ad5
AW
2765 SCM_STRUCT_SLOT_SET (obj, idx, val);
2766 NEXT (1);
510ca126
AW
2767 }
2768
2769 SYNC_IP ();
4c906ad5 2770 scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val);
510ca126
AW
2771 NEXT (1);
2772 }
2773
2774 /* class-of dst:12 type:12
2775 *
2776 * Store the vtable of SRC into DST.
2777 */
d38ca16e 2778 VM_DEFINE_OP (105, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2779 {
2780 ARGS1 (obj);
2781 if (SCM_INSTANCEP (obj))
2782 RETURN (SCM_CLASS_OF (obj));
2783 SYNC_IP ();
2784 RETURN (scm_class_of (obj));
2785 }
2786
510ca126
AW
2787 \f
2788
2789 /*
2790 * Arrays, packed uniform arrays, and bytevectors.
2791 */
2792
2793 /* load-typed-array dst:8 type:8 shape:8 offset:32 len:32
2794 *
2795 * Load the contiguous typed array located at OFFSET 32-bit words away
2796 * from the instruction pointer, and store into DST. LEN is a byte
2797 * length. OFFSET is signed.
2798 */
d38ca16e 2799 VM_DEFINE_OP (106, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
510ca126
AW
2800 {
2801 scm_t_uint8 dst, type, shape;
2802 scm_t_int32 offset;
2803 scm_t_uint32 len;
2804
20b1b913 2805 UNPACK_8_8_8 (op, dst, type, shape);
510ca126
AW
2806 offset = ip[1];
2807 len = ip[2];
2808 SYNC_IP ();
2809 LOCAL_SET (dst, scm_from_contiguous_typed_array (LOCAL_REF (type),
2810 LOCAL_REF (shape),
2811 ip + offset, len));
2812 NEXT (3);
2813 }
2814
c09708f9 2815 /* make-array dst:8 type:8 fill:8 _:8 bounds:24
510ca126
AW
2816 *
2817 * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
2818 */
d38ca16e 2819 VM_DEFINE_OP (107, make_array, "make-array", OP2 (U8_U8_U8_U8, X8_U24) | OP_DST)
510ca126 2820 {
c09708f9
AW
2821 scm_t_uint8 dst, type, fill, bounds;
2822 UNPACK_8_8_8 (op, dst, type, fill);
2823 UNPACK_24 (ip[1], bounds);
510ca126
AW
2824 SYNC_IP ();
2825 LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill),
2826 LOCAL_REF (bounds)));
2827 NEXT (2);
2828 }
2829
2830 /* bv-u8-ref dst:8 src:8 idx:8
2831 * bv-s8-ref dst:8 src:8 idx:8
2832 * bv-u16-ref dst:8 src:8 idx:8
2833 * bv-s16-ref dst:8 src:8 idx:8
2834 * bv-u32-ref dst:8 src:8 idx:8
2835 * bv-s32-ref dst:8 src:8 idx:8
2836 * bv-u64-ref dst:8 src:8 idx:8
2837 * bv-s64-ref dst:8 src:8 idx:8
2838 * bv-f32-ref dst:8 src:8 idx:8
2839 * bv-f64-ref dst:8 src:8 idx:8
2840 *
2841 * Fetch the item at byte offset IDX in the bytevector SRC, and store
2842 * it in DST. All accesses use native endianness.
2843 */
2844#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
2845 do { \
2846 scm_t_signed_bits i; \
2847 const scm_t_ ## type *int_ptr; \
2848 ARGS2 (bv, idx); \
2849 \
2850 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2851 i = SCM_I_INUM (idx); \
2852 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2853 \
2854 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2855 && (i >= 0) \
2856 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2857 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2858 RETURN (SCM_I_MAKINUM (*int_ptr)); \
2859 else \
2860 { \
2861 SYNC_IP (); \
2862 RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx)); \
2863 } \
2864 } while (0)
2865
2866#define BV_INT_REF(stem, type, size) \
2867 do { \
2868 scm_t_signed_bits i; \
2869 const scm_t_ ## type *int_ptr; \
2870 ARGS2 (bv, idx); \
2871 \
2872 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2873 i = SCM_I_INUM (idx); \
2874 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2875 \
2876 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2877 && (i >= 0) \
2878 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2879 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2880 { \
2881 scm_t_ ## type x = *int_ptr; \
2882 if (SCM_FIXABLE (x)) \
2883 RETURN (SCM_I_MAKINUM (x)); \
2884 else \
2885 { \
2886 SYNC_IP (); \
2887 RETURN (scm_from_ ## type (x)); \
2888 } \
2889 } \
2890 else \
2891 { \
2892 SYNC_IP (); \
2893 RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx)); \
2894 } \
2895 } while (0)
2896
2897#define BV_FLOAT_REF(stem, fn_stem, type, size) \
2898 do { \
2899 scm_t_signed_bits i; \
2900 const type *float_ptr; \
2901 ARGS2 (bv, idx); \
2902 \
2903 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2904 i = SCM_I_INUM (idx); \
2905 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2906 \
2907 SYNC_IP (); \
2908 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2909 && (i >= 0) \
2910 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2911 && (ALIGNED_P (float_ptr, type)))) \
2912 RETURN (scm_from_double (*float_ptr)); \
2913 else \
2914 RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
2915 } while (0)
2916
d38ca16e 2917 VM_DEFINE_OP (108, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2918 BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
2919
d38ca16e 2920 VM_DEFINE_OP (109, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2921 BV_FIXABLE_INT_REF (s8, s8, int8, 1);
2922
d38ca16e 2923 VM_DEFINE_OP (110, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2924 BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
2925
d38ca16e 2926 VM_DEFINE_OP (111, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2927 BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
2928
d38ca16e 2929 VM_DEFINE_OP (112, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2930#if SIZEOF_VOID_P > 4
2931 BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
2932#else
2933 BV_INT_REF (u32, uint32, 4);
2934#endif
2935
d38ca16e 2936 VM_DEFINE_OP (113, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2937#if SIZEOF_VOID_P > 4
2938 BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
2939#else
2940 BV_INT_REF (s32, int32, 4);
2941#endif
2942
d38ca16e 2943 VM_DEFINE_OP (114, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2944 BV_INT_REF (u64, uint64, 8);
2945
d38ca16e 2946 VM_DEFINE_OP (115, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2947 BV_INT_REF (s64, int64, 8);
2948
d38ca16e 2949 VM_DEFINE_OP (116, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2950 BV_FLOAT_REF (f32, ieee_single, float, 4);
2951
d38ca16e 2952 VM_DEFINE_OP (117, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2953 BV_FLOAT_REF (f64, ieee_double, double, 8);
2954
2955 /* bv-u8-set! dst:8 idx:8 src:8
2956 * bv-s8-set! dst:8 idx:8 src:8
2957 * bv-u16-set! dst:8 idx:8 src:8
2958 * bv-s16-set! dst:8 idx:8 src:8
2959 * bv-u32-set! dst:8 idx:8 src:8
2960 * bv-s32-set! dst:8 idx:8 src:8
2961 * bv-u64-set! dst:8 idx:8 src:8
2962 * bv-s64-set! dst:8 idx:8 src:8
2963 * bv-f32-set! dst:8 idx:8 src:8
2964 * bv-f64-set! dst:8 idx:8 src:8
2965 *
2966 * Store SRC into the bytevector DST at byte offset IDX. Multibyte
2967 * values are written using native endianness.
2968 */
2969#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
2970 do { \
2971 scm_t_uint8 dst, idx, src; \
2972 scm_t_signed_bits i, j = 0; \
2973 SCM bv, scm_idx, val; \
2974 scm_t_ ## type *int_ptr; \
2975 \
20b1b913 2976 UNPACK_8_8_8 (op, dst, idx, src); \
510ca126
AW
2977 bv = LOCAL_REF (dst); \
2978 scm_idx = LOCAL_REF (idx); \
2979 val = LOCAL_REF (src); \
ecbef966 2980 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
510ca126
AW
2981 i = SCM_I_INUM (scm_idx); \
2982 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2983 \
2984 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2985 && (i >= 0) \
2986 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2987 && (ALIGNED_P (int_ptr, scm_t_ ## type)) \
2988 && (SCM_I_INUMP (val)) \
2989 && ((j = SCM_I_INUM (val)) >= min) \
2990 && (j <= max))) \
2991 *int_ptr = (scm_t_ ## type) j; \
2992 else \
2993 { \
2994 SYNC_IP (); \
2995 scm_bytevector_ ## fn_stem ## _set_x (bv, scm_idx, val); \
2996 } \
2997 NEXT (1); \
2998 } while (0)
2999
3000#define BV_INT_SET(stem, type, size) \
3001 do { \
3002 scm_t_uint8 dst, idx, src; \
3003 scm_t_signed_bits i; \
3004 SCM bv, scm_idx, val; \
3005 scm_t_ ## type *int_ptr; \
3006 \
20b1b913 3007 UNPACK_8_8_8 (op, dst, idx, src); \
510ca126
AW
3008 bv = LOCAL_REF (dst); \
3009 scm_idx = LOCAL_REF (idx); \
3010 val = LOCAL_REF (src); \
ecbef966 3011 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
510ca126
AW
3012 i = SCM_I_INUM (scm_idx); \
3013 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
3014 \
3015 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
3016 && (i >= 0) \
3017 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
3018 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
3019 *int_ptr = scm_to_ ## type (val); \
3020 else \
3021 { \
3022 SYNC_IP (); \
3023 scm_bytevector_ ## stem ## _native_set_x (bv, scm_idx, val); \
3024 } \
3025 NEXT (1); \
3026 } while (0)
3027
3028#define BV_FLOAT_SET(stem, fn_stem, type, size) \
3029 do { \
3030 scm_t_uint8 dst, idx, src; \
3031 scm_t_signed_bits i; \
3032 SCM bv, scm_idx, val; \
3033 type *float_ptr; \
3034 \
20b1b913 3035 UNPACK_8_8_8 (op, dst, idx, src); \
510ca126
AW
3036 bv = LOCAL_REF (dst); \
3037 scm_idx = LOCAL_REF (idx); \
3038 val = LOCAL_REF (src); \
ecbef966 3039 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
510ca126
AW
3040 i = SCM_I_INUM (scm_idx); \
3041 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
3042 \
3043 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
3044 && (i >= 0) \
3045 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
3046 && (ALIGNED_P (float_ptr, type)))) \
3047 *float_ptr = scm_to_double (val); \
3048 else \
3049 { \
3050 SYNC_IP (); \
3051 scm_bytevector_ ## fn_stem ## _native_set_x (bv, scm_idx, val); \
3052 } \
3053 NEXT (1); \
3054 } while (0)
3055
d38ca16e 3056 VM_DEFINE_OP (118, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3057 BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
3058
d38ca16e 3059 VM_DEFINE_OP (119, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3060 BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
3061
d38ca16e 3062 VM_DEFINE_OP (120, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3063 BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
3064
d38ca16e 3065 VM_DEFINE_OP (121, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3066 BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
3067
d38ca16e 3068 VM_DEFINE_OP (122, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3069#if SIZEOF_VOID_P > 4
3070 BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
3071#else
3072 BV_INT_SET (u32, uint32, 4);
3073#endif
3074
d38ca16e 3075 VM_DEFINE_OP (123, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3076#if SIZEOF_VOID_P > 4
3077 BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
3078#else
3079 BV_INT_SET (s32, int32, 4);
3080#endif
3081
d38ca16e 3082 VM_DEFINE_OP (124, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3083 BV_INT_SET (u64, uint64, 8);
3084
d38ca16e 3085 VM_DEFINE_OP (125, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3086 BV_INT_SET (s64, int64, 8);
3087
d38ca16e 3088 VM_DEFINE_OP (126, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3089 BV_FLOAT_SET (f32, ieee_single, float, 4);
3090
d38ca16e 3091 VM_DEFINE_OP (127, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3092 BV_FLOAT_SET (f64, ieee_double, double, 8);
3093
8c6206f3
AW
3094 /* br-if-logtest a:12 b:12 invert:1 _:7 offset:24
3095 *
3096 * If the exact integer in A has any bits in common with the exact
3097 * integer in B, add OFFSET, a signed 24-bit number, to the current
3098 * instruction pointer.
3099 */
3100 VM_DEFINE_OP (128, br_if_logtest, "br-if-logtest", OP2 (U8_U12_U12, B1_X7_L24))
3101 {
3102 BR_BINARY (x, y,
3103 ((SCM_I_INUMP (x) && SCM_I_INUMP (y))
3104 ? (SCM_UNPACK (x) & SCM_UNPACK (y) & ~scm_tc2_int)
3105 : scm_is_true (scm_logtest (x, y))));
3106 }
3107
d86682ba
AW
3108 VM_DEFINE_OP (129, unused_129, NULL, NOP)
3109 VM_DEFINE_OP (130, unused_130, NULL, NOP)
3110 VM_DEFINE_OP (131, unused_131, NULL, NOP)
3111 VM_DEFINE_OP (132, unused_132, NULL, NOP)
3112 VM_DEFINE_OP (133, unused_133, NULL, NOP)
3113 VM_DEFINE_OP (134, unused_134, NULL, NOP)
3114 VM_DEFINE_OP (135, unused_135, NULL, NOP)
3115 VM_DEFINE_OP (136, unused_136, NULL, NOP)
3116 VM_DEFINE_OP (137, unused_137, NULL, NOP)
3117 VM_DEFINE_OP (138, unused_138, NULL, NOP)
3118 VM_DEFINE_OP (139, unused_139, NULL, NOP)
3119 VM_DEFINE_OP (140, unused_140, NULL, NOP)
3120 VM_DEFINE_OP (141, unused_141, NULL, NOP)
3121 VM_DEFINE_OP (142, unused_142, NULL, NOP)
3122 VM_DEFINE_OP (143, unused_143, NULL, NOP)
3123 VM_DEFINE_OP (144, unused_144, NULL, NOP)
3124 VM_DEFINE_OP (145, unused_145, NULL, NOP)
3125 VM_DEFINE_OP (146, unused_146, NULL, NOP)
3126 VM_DEFINE_OP (147, unused_147, NULL, NOP)
3127 VM_DEFINE_OP (148, unused_148, NULL, NOP)
3128 VM_DEFINE_OP (149, unused_149, NULL, NOP)
3129 VM_DEFINE_OP (150, unused_150, NULL, NOP)
3130 VM_DEFINE_OP (151, unused_151, NULL, NOP)
3131 VM_DEFINE_OP (152, unused_152, NULL, NOP)
3132 VM_DEFINE_OP (153, unused_153, NULL, NOP)
3133 VM_DEFINE_OP (154, unused_154, NULL, NOP)
3134 VM_DEFINE_OP (155, unused_155, NULL, NOP)
3135 VM_DEFINE_OP (156, unused_156, NULL, NOP)
3136 VM_DEFINE_OP (157, unused_157, NULL, NOP)
3137 VM_DEFINE_OP (158, unused_158, NULL, NOP)
3138 VM_DEFINE_OP (159, unused_159, NULL, NOP)
3139 VM_DEFINE_OP (160, unused_160, NULL, NOP)
3140 VM_DEFINE_OP (161, unused_161, NULL, NOP)
3141 VM_DEFINE_OP (162, unused_162, NULL, NOP)
3142 VM_DEFINE_OP (163, unused_163, NULL, NOP)
3143 VM_DEFINE_OP (164, unused_164, NULL, NOP)
3144 VM_DEFINE_OP (165, unused_165, NULL, NOP)
3145 VM_DEFINE_OP (166, unused_166, NULL, NOP)
3146 VM_DEFINE_OP (167, unused_167, NULL, NOP)
3147 VM_DEFINE_OP (168, unused_168, NULL, NOP)
3148 VM_DEFINE_OP (169, unused_169, NULL, NOP)
3149 VM_DEFINE_OP (170, unused_170, NULL, NOP)
3150 VM_DEFINE_OP (171, unused_171, NULL, NOP)
3151 VM_DEFINE_OP (172, unused_172, NULL, NOP)
3152 VM_DEFINE_OP (173, unused_173, NULL, NOP)
3153 VM_DEFINE_OP (174, unused_174, NULL, NOP)
3154 VM_DEFINE_OP (175, unused_175, NULL, NOP)
3155 VM_DEFINE_OP (176, unused_176, NULL, NOP)
3156 VM_DEFINE_OP (177, unused_177, NULL, NOP)
3157 VM_DEFINE_OP (178, unused_178, NULL, NOP)
3158 VM_DEFINE_OP (179, unused_179, NULL, NOP)
3159 VM_DEFINE_OP (180, unused_180, NULL, NOP)
3160 VM_DEFINE_OP (181, unused_181, NULL, NOP)
3161 VM_DEFINE_OP (182, unused_182, NULL, NOP)
3162 VM_DEFINE_OP (183, unused_183, NULL, NOP)
3163 VM_DEFINE_OP (184, unused_184, NULL, NOP)
3164 VM_DEFINE_OP (185, unused_185, NULL, NOP)
3165 VM_DEFINE_OP (186, unused_186, NULL, NOP)
3166 VM_DEFINE_OP (187, unused_187, NULL, NOP)
3167 VM_DEFINE_OP (188, unused_188, NULL, NOP)
3168 VM_DEFINE_OP (189, unused_189, NULL, NOP)
3169 VM_DEFINE_OP (190, unused_190, NULL, NOP)
3170 VM_DEFINE_OP (191, unused_191, NULL, NOP)
3171 VM_DEFINE_OP (192, unused_192, NULL, NOP)
3172 VM_DEFINE_OP (193, unused_193, NULL, NOP)
3173 VM_DEFINE_OP (194, unused_194, NULL, NOP)
3174 VM_DEFINE_OP (195, unused_195, NULL, NOP)
3175 VM_DEFINE_OP (196, unused_196, NULL, NOP)
3176 VM_DEFINE_OP (197, unused_197, NULL, NOP)
3177 VM_DEFINE_OP (198, unused_198, NULL, NOP)
3178 VM_DEFINE_OP (199, unused_199, NULL, NOP)
3179 VM_DEFINE_OP (200, unused_200, NULL, NOP)
3180 VM_DEFINE_OP (201, unused_201, NULL, NOP)
3181 VM_DEFINE_OP (202, unused_202, NULL, NOP)
3182 VM_DEFINE_OP (203, unused_203, NULL, NOP)
3183 VM_DEFINE_OP (204, unused_204, NULL, NOP)
3184 VM_DEFINE_OP (205, unused_205, NULL, NOP)
3185 VM_DEFINE_OP (206, unused_206, NULL, NOP)
3186 VM_DEFINE_OP (207, unused_207, NULL, NOP)
3187 VM_DEFINE_OP (208, unused_208, NULL, NOP)
3188 VM_DEFINE_OP (209, unused_209, NULL, NOP)
3189 VM_DEFINE_OP (210, unused_210, NULL, NOP)
3190 VM_DEFINE_OP (211, unused_211, NULL, NOP)
3191 VM_DEFINE_OP (212, unused_212, NULL, NOP)
3192 VM_DEFINE_OP (213, unused_213, NULL, NOP)
3193 VM_DEFINE_OP (214, unused_214, NULL, NOP)
3194 VM_DEFINE_OP (215, unused_215, NULL, NOP)
3195 VM_DEFINE_OP (216, unused_216, NULL, NOP)
3196 VM_DEFINE_OP (217, unused_217, NULL, NOP)
3197 VM_DEFINE_OP (218, unused_218, NULL, NOP)
3198 VM_DEFINE_OP (219, unused_219, NULL, NOP)
3199 VM_DEFINE_OP (220, unused_220, NULL, NOP)
3200 VM_DEFINE_OP (221, unused_221, NULL, NOP)
3201 VM_DEFINE_OP (222, unused_222, NULL, NOP)
3202 VM_DEFINE_OP (223, unused_223, NULL, NOP)
3203 VM_DEFINE_OP (224, unused_224, NULL, NOP)
3204 VM_DEFINE_OP (225, unused_225, NULL, NOP)
3205 VM_DEFINE_OP (226, unused_226, NULL, NOP)
3206 VM_DEFINE_OP (227, unused_227, NULL, NOP)
3207 VM_DEFINE_OP (228, unused_228, NULL, NOP)
3208 VM_DEFINE_OP (229, unused_229, NULL, NOP)
3209 VM_DEFINE_OP (230, unused_230, NULL, NOP)
3210 VM_DEFINE_OP (231, unused_231, NULL, NOP)
3211 VM_DEFINE_OP (232, unused_232, NULL, NOP)
3212 VM_DEFINE_OP (233, unused_233, NULL, NOP)
3213 VM_DEFINE_OP (234, unused_234, NULL, NOP)
3214 VM_DEFINE_OP (235, unused_235, NULL, NOP)
3215 VM_DEFINE_OP (236, unused_236, NULL, NOP)
3216 VM_DEFINE_OP (237, unused_237, NULL, NOP)
3217 VM_DEFINE_OP (238, unused_238, NULL, NOP)
3218 VM_DEFINE_OP (239, unused_239, NULL, NOP)
3219 VM_DEFINE_OP (240, unused_240, NULL, NOP)
3220 VM_DEFINE_OP (241, unused_241, NULL, NOP)
3221 VM_DEFINE_OP (242, unused_242, NULL, NOP)
3222 VM_DEFINE_OP (243, unused_243, NULL, NOP)
3223 VM_DEFINE_OP (244, unused_244, NULL, NOP)
3224 VM_DEFINE_OP (245, unused_245, NULL, NOP)
3225 VM_DEFINE_OP (246, unused_246, NULL, NOP)
3226 VM_DEFINE_OP (247, unused_247, NULL, NOP)
3227 VM_DEFINE_OP (248, unused_248, NULL, NOP)
3228 VM_DEFINE_OP (249, unused_249, NULL, NOP)
3229 VM_DEFINE_OP (250, unused_250, NULL, NOP)
3230 VM_DEFINE_OP (251, unused_251, NULL, NOP)
3231 VM_DEFINE_OP (252, unused_252, NULL, NOP)
3232 VM_DEFINE_OP (253, unused_253, NULL, NOP)
3233 VM_DEFINE_OP (254, unused_254, NULL, NOP)
3234 VM_DEFINE_OP (255, unused_255, NULL, NOP)
3235 {
3236 vm_error_bad_instruction (op);
3237 abort (); /* never reached */
3238 }
510ca126 3239
d86682ba 3240 END_DISPATCH_SWITCH;
510ca126
AW
3241}
3242
3243
3244#undef ABORT_CONTINUATION_HOOK
3245#undef ALIGNED_P
3246#undef APPLY_HOOK
3247#undef ARGS1
3248#undef ARGS2
3249#undef BEGIN_DISPATCH_SWITCH
3250#undef BINARY_INTEGER_OP
3251#undef BR_ARITHMETIC
3252#undef BR_BINARY
3253#undef BR_NARGS
3254#undef BR_UNARY
3255#undef BV_FIXABLE_INT_REF
3256#undef BV_FIXABLE_INT_SET
3257#undef BV_FLOAT_REF
3258#undef BV_FLOAT_SET
3259#undef BV_INT_REF
3260#undef BV_INT_SET
3261#undef CACHE_REGISTER
510ca126
AW
3262#undef END_DISPATCH_SWITCH
3263#undef FREE_VARIABLE_REF
3264#undef INIT
3265#undef INUM_MAX
3266#undef INUM_MIN
3267#undef LOCAL_REF
3268#undef LOCAL_SET
3269#undef NEXT
3270#undef NEXT_HOOK
3271#undef NEXT_JUMP
3272#undef POP_CONTINUATION_HOOK
3273#undef PUSH_CONTINUATION_HOOK
510ca126
AW
3274#undef RETURN
3275#undef RETURN_ONE_VALUE
3276#undef RETURN_VALUE_LIST
3277#undef RUN_HOOK
3278#undef RUN_HOOK0
ea0cd17d 3279#undef RUN_HOOK1
510ca126 3280#undef SYNC_IP
20b1b913
AW
3281#undef UNPACK_8_8_8
3282#undef UNPACK_8_16
3283#undef UNPACK_16_8
3284#undef UNPACK_12_12
3285#undef UNPACK_24
510ca126
AW
3286#undef VARIABLE_BOUNDP
3287#undef VARIABLE_REF
3288#undef VARIABLE_SET
3289#undef VM_CHECK_FREE_VARIABLE
3290#undef VM_CHECK_OBJECT
3291#undef VM_CHECK_UNDERFLOW
3292#undef VM_DEFINE_OP
3293#undef VM_INSTRUCTION_TO_LABEL
3294#undef VM_USE_HOOKS
3295#undef VM_VALIDATE_BYTEVECTOR
3296#undef VM_VALIDATE_PAIR
3297#undef VM_VALIDATE_STRUCT
3298
3299/*
3300(defun renumber-ops ()
3301 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
3302 (interactive "")
3303 (save-excursion
3304 (let ((counter -1)) (goto-char (point-min))
3305 (while (re-search-forward "^ *VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
3306 (replace-match
3307 (number-to-string (setq counter (1+ counter)))
3308 t t nil 1)))))
3309(renumber-ops)
3310*/
17e90c5e
KN
3311/*
3312 Local Variables:
3313 c-file-style: "gnu"
3314 End:
3315*/