elisp @@ macro
[bpt/guile.git] / libguile / vm-engine.c
CommitLineData
475772ea 1/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013,
27b3b5b9 2 * 2014, 2015 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 \
aef1fcf9 131 SCM_ASYNC_TICK_WITH_GUARD_CODE (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
aef1fcf9 421VM_NAME (scm_i_thread *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--)
aef1fcf9 521 ret = scm_inline_cons (thread, 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
aef1fcf9
AW
870 ret = scm_i_foreign_call (scm_inline_cons (thread, cif, pointer),
871 LOCAL_ADDRESS (1));
510ca126 872
4a1ce016 873 CACHE_FP ();
510ca126
AW
874
875 if (SCM_UNLIKELY (SCM_VALUESP (ret)))
876 /* multiple values returned to continuation */
877 RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
878 else
879 RETURN_ONE_VALUE (ret);
880 }
881
882 /* continuation-call contregs:24
883 *
884 * Return to a continuation, nonlocally. The arguments to the
885 * continuation are taken from the stack. CONTREGS is a free variable
886 * containing the reified continuation. This instruction is part of
887 * the implementation of undelimited continuations, and is not
888 * generated by the compiler.
889 */
b3ae2b50 890 VM_DEFINE_OP (12, continuation_call, "continuation-call", OP1 (U8_U24))
510ca126
AW
891 {
892 SCM contregs;
893 scm_t_uint32 contregs_idx;
894
20b1b913 895 UNPACK_24 (op, contregs_idx);
510ca126 896
7396d216 897 contregs =
d798a895 898 SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
510ca126
AW
899
900 SYNC_IP ();
901 scm_i_check_continuation (contregs);
796e54a7 902 vm_return_to_continuation (scm_i_contregs_vp (contregs),
510ca126 903 scm_i_contregs_vm_cont (contregs),
b636cdb0
AW
904 FRAME_LOCALS_COUNT_FROM (1),
905 LOCAL_ADDRESS (1));
510ca126
AW
906 scm_i_reinstate_continuation (contregs);
907
908 /* no NEXT */
909 abort ();
910 }
911
912 /* compose-continuation cont:24
913 *
914 * Compose a partial continution with the current continuation. The
915 * arguments to the continuation are taken from the stack. CONT is a
916 * free variable containing the reified continuation. This
917 * instruction is part of the implementation of partial continuations,
918 * and is not generated by the compiler.
919 */
b3ae2b50 920 VM_DEFINE_OP (13, compose_continuation, "compose-continuation", OP1 (U8_U24))
510ca126
AW
921 {
922 SCM vmcont;
923 scm_t_uint32 cont_idx;
924
20b1b913 925 UNPACK_24 (op, cont_idx);
d798a895 926 vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
510ca126
AW
927
928 SYNC_IP ();
929 VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
930 vm_error_continuation_not_rewindable (vmcont));
44ece399 931 vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1),
b636cdb0 932 LOCAL_ADDRESS (1),
aef1fcf9 933 &thread->dynstack,
dd1c7dec 934 registers);
510ca126
AW
935 CACHE_REGISTER ();
936 NEXT (0);
937 }
938
adb8d905 939 /* tail-apply _:24
510ca126
AW
940 *
941 * Tail-apply the procedure in local slot 0 to the rest of the
942 * arguments. This instruction is part of the implementation of
943 * `apply', and is not generated by the compiler.
944 */
b3ae2b50 945 VM_DEFINE_OP (14, tail_apply, "tail-apply", OP1 (U8_X24))
510ca126 946 {
e93c0430 947 int i, list_idx, list_len, nlocals;
510ca126
AW
948 SCM list;
949
950 VM_HANDLE_INTERRUPTS;
951
e93c0430
AW
952 nlocals = FRAME_LOCALS_COUNT ();
953 // At a minimum, there should be apply, f, and the list.
954 VM_ASSERT (nlocals >= 3, abort ());
955 list_idx = nlocals - 1;
510ca126
AW
956 list = LOCAL_REF (list_idx);
957 list_len = scm_ilength (list);
958
959 VM_ASSERT (list_len >= 0, vm_error_apply_to_non_list (list));
960
e93c0430
AW
961 nlocals = nlocals - 2 + list_len;
962 ALLOC_FRAME (nlocals);
510ca126 963
e93c0430
AW
964 for (i = 1; i < list_idx; i++)
965 LOCAL_SET (i - 1, LOCAL_REF (i));
510ca126
AW
966
967 /* Null out these slots, just in case there are less than 2 elements
968 in the list. */
7396d216
AW
969 LOCAL_SET (list_idx - 1, SCM_UNDEFINED);
970 LOCAL_SET (list_idx, SCM_UNDEFINED);
510ca126
AW
971
972 for (i = 0; i < list_len; i++, list = SCM_CDR (list))
7396d216 973 LOCAL_SET (list_idx - 1 + i, SCM_CAR (list));
510ca126 974
73fc4e73 975 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
510ca126
AW
976 goto apply;
977
73fc4e73 978 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
979
980 APPLY_HOOK ();
981
510ca126
AW
982 NEXT (0);
983 }
984
985 /* call/cc _:24
986 *
987 * Capture the current continuation, and tail-apply the procedure in
d691ac20 988 * local slot 1 to it. This instruction is part of the implementation
510ca126
AW
989 * of `call/cc', and is not generated by the compiler.
990 */
b3ae2b50 991 VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (U8_X24))
510ca126
AW
992 {
993 SCM vm_cont, cont;
994 scm_t_dynstack *dynstack;
d691ac20 995 int first;
510ca126
AW
996
997 VM_HANDLE_INTERRUPTS;
998
999 SYNC_IP ();
aef1fcf9 1000 dynstack = scm_dynstack_capture_all (&thread->dynstack);
510ca126
AW
1001 vm_cont = scm_i_vm_capture_stack (vp->stack_base,
1002 SCM_FRAME_DYNAMIC_LINK (fp),
b636cdb0 1003 SCM_FRAME_PREVIOUS_SP (fp),
510ca126 1004 SCM_FRAME_RETURN_ADDRESS (fp),
510ca126
AW
1005 dynstack,
1006 0);
d691ac20
AW
1007 /* FIXME: Seems silly to capture the registers here, when they are
1008 already captured in the registers local, which here we are
1009 copying out to the heap; and likewise, the setjmp(&registers)
1010 code already has the non-local return handler. But oh
1011 well! */
796e54a7 1012 cont = scm_i_make_continuation (&first, vp, vm_cont);
d691ac20
AW
1013
1014 if (first)
1015 {
1016 LOCAL_SET (0, LOCAL_REF (1));
1017 LOCAL_SET (1, cont);
1018 RESET_FRAME (2);
510ca126 1019
73fc4e73 1020 if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
d691ac20 1021 goto apply;
510ca126 1022
73fc4e73 1023 ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
f5cb70e9
AW
1024
1025 APPLY_HOOK ();
1026
d691ac20
AW
1027 NEXT (0);
1028 }
1029 else
1030 {
1031 CACHE_REGISTER ();
b636cdb0 1032 ABORT_CONTINUATION_HOOK ();
d691ac20
AW
1033 NEXT (0);
1034 }
510ca126 1035 }
510ca126 1036
486013d6
AW
1037 /* abort _:24
1038 *
1039 * Abort to a prompt handler. The tag is expected in r1, and the rest
1040 * of the values in the frame are returned to the prompt handler.
1041 * This corresponds to a tail application of abort-to-prompt.
1042 */
b3ae2b50 1043 VM_DEFINE_OP (16, abort, "abort", OP1 (U8_X24))
486013d6
AW
1044 {
1045 scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
1046
1047 ASSERT (nlocals >= 2);
186b56c4
AW
1048 /* FIXME: Really we should capture the caller's registers. Until
1049 then, manually advance the IP so that when the prompt resumes,
1050 it continues with the next instruction. */
1051 ip++;
486013d6 1052 SYNC_IP ();
b44f5451 1053 vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
dd1c7dec 1054 SCM_EOL, LOCAL_ADDRESS (0), registers);
486013d6
AW
1055
1056 /* vm_abort should not return */
1057 abort ();
1058 }
1059
1060 /* builtin-ref dst:12 idx:12
1061 *
1062 * Load a builtin stub by index into DST.
1063 */
b3ae2b50 1064 VM_DEFINE_OP (17, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST)
486013d6
AW
1065 {
1066 scm_t_uint16 dst, idx;
1067
20b1b913 1068 UNPACK_12_12 (op, dst, idx);
486013d6
AW
1069 LOCAL_SET (dst, scm_vm_builtin_ref (idx));
1070
1071 NEXT (1);
1072 }
1073
510ca126
AW
1074
1075 \f
1076
1077 /*
1078 * Function prologues
1079 */
1080
1081 /* br-if-nargs-ne expected:24 _:8 offset:24
1082 * br-if-nargs-lt expected:24 _:8 offset:24
1083 * br-if-nargs-gt expected:24 _:8 offset:24
1084 *
1085 * If the number of actual arguments is not equal, less than, or greater
1086 * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
1087 * the current instruction pointer.
1088 */
b3ae2b50 1089 VM_DEFINE_OP (18, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
510ca126
AW
1090 {
1091 BR_NARGS (!=);
1092 }
b3ae2b50 1093 VM_DEFINE_OP (19, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
510ca126
AW
1094 {
1095 BR_NARGS (<);
1096 }
b3ae2b50 1097 VM_DEFINE_OP (20, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
510ca126
AW
1098 {
1099 BR_NARGS (>);
1100 }
1101
1102 /* assert-nargs-ee expected:24
1103 * assert-nargs-ge expected:24
1104 * assert-nargs-le expected:24
1105 *
1106 * If the number of actual arguments is not ==, >=, or <= EXPECTED,
1107 * respectively, signal an error.
1108 */
b3ae2b50 1109 VM_DEFINE_OP (21, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
510ca126
AW
1110 {
1111 scm_t_uint32 expected;
20b1b913 1112 UNPACK_24 (op, expected);
510ca126 1113 VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
73fc4e73 1114 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1115 NEXT (1);
1116 }
b3ae2b50 1117 VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
510ca126
AW
1118 {
1119 scm_t_uint32 expected;
20b1b913 1120 UNPACK_24 (op, expected);
510ca126 1121 VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
73fc4e73 1122 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1123 NEXT (1);
1124 }
b3ae2b50 1125 VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
510ca126
AW
1126 {
1127 scm_t_uint32 expected;
20b1b913 1128 UNPACK_24 (op, expected);
510ca126 1129 VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
73fc4e73 1130 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1131 NEXT (1);
1132 }
1133
af95414f 1134 /* alloc-frame nlocals:24
510ca126
AW
1135 *
1136 * Ensure that there is space on the stack for NLOCALS local variables,
1137 * setting them all to SCM_UNDEFINED, except those nargs values that
7396d216 1138 * were passed as arguments and procedure.
510ca126 1139 */
b3ae2b50 1140 VM_DEFINE_OP (24, alloc_frame, "alloc-frame", OP1 (U8_U24))
510ca126
AW
1141 {
1142 scm_t_uint32 nlocals, nargs;
20b1b913 1143 UNPACK_24 (op, nlocals);
510ca126
AW
1144
1145 nargs = FRAME_LOCALS_COUNT ();
1146 ALLOC_FRAME (nlocals);
1147 while (nlocals-- > nargs)
1148 LOCAL_SET (nlocals, SCM_UNDEFINED);
1149
1150 NEXT (1);
1151 }
1152
af95414f
AW
1153 /* reset-frame nlocals:24
1154 *
1155 * Like alloc-frame, but doesn't check that the stack is big enough.
1156 * Used to reset the frame size to something less than the size that
1157 * was previously set via alloc-frame.
1158 */
b3ae2b50 1159 VM_DEFINE_OP (25, reset_frame, "reset-frame", OP1 (U8_U24))
af95414f
AW
1160 {
1161 scm_t_uint32 nlocals;
20b1b913 1162 UNPACK_24 (op, nlocals);
af95414f
AW
1163 RESET_FRAME (nlocals);
1164 NEXT (1);
1165 }
1166
510ca126
AW
1167 /* assert-nargs-ee/locals expected:12 nlocals:12
1168 *
1169 * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
1170 * number of locals reserved is EXPECTED + NLOCALS.
1171 */
b3ae2b50 1172 VM_DEFINE_OP (26, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
510ca126
AW
1173 {
1174 scm_t_uint16 expected, nlocals;
20b1b913 1175 UNPACK_12_12 (op, expected, nlocals);
510ca126 1176 VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
73fc4e73 1177 vm_error_wrong_num_args (LOCAL_REF (0)));
510ca126
AW
1178 ALLOC_FRAME (expected + nlocals);
1179 while (nlocals--)
1180 LOCAL_SET (expected + nlocals, SCM_UNDEFINED);
1181
1182 NEXT (1);
1183 }
1184
f90c0554
AW
1185 /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
1186 *
1187 * Find the first positional argument after NREQ. If it is greater
1188 * than NPOS, jump to OFFSET.
1189 *
1190 * This instruction is only emitted for functions with multiple
1191 * clauses, and an earlier clause has keywords and no rest arguments.
1192 * See "Case-lambda" in the manual, for more on how case-lambda
1193 * chooses the clause to apply.
1194 */
b3ae2b50 1195 VM_DEFINE_OP (27, br_if_npos_gt, "br-if-npos-gt", OP3 (U8_U24, X8_U24, X8_L24))
f90c0554
AW
1196 {
1197 scm_t_uint32 nreq, npos;
1198
20b1b913
AW
1199 UNPACK_24 (op, nreq);
1200 UNPACK_24 (ip[1], npos);
f90c0554
AW
1201
1202 /* We can only have too many positionals if there are more
1203 arguments than NPOS. */
1204 if (FRAME_LOCALS_COUNT() > npos)
1205 {
1206 scm_t_uint32 n;
1207 for (n = nreq; n < npos; n++)
1208 if (scm_is_keyword (LOCAL_REF (n)))
1209 break;
1210 if (n == npos && !scm_is_keyword (LOCAL_REF (n)))
1211 {
1212 scm_t_int32 offset = ip[2];
1213 offset >>= 8; /* Sign-extending shift. */
1214 NEXT (offset);
1215 }
1216 }
1217 NEXT (3);
1218 }
1219
02f9d496
AW
1220 /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
1221 *
1222 * flags := allow-other-keys:1 has-rest:1 _:6
510ca126
AW
1223 *
1224 * Find the last positional argument, and shuffle all the rest above
1225 * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then
1226 * load the constant at KW-OFFSET words from the current IP, and use it
1227 * to bind keyword arguments. If HAS-REST, collect all shuffled
1228 * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear
1229 * the arguments that we shuffled up.
1230 *
1231 * A macro-mega-instruction.
1232 */
b3ae2b50 1233 VM_DEFINE_OP (28, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32))
510ca126
AW
1234 {
1235 scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs;
1236 scm_t_int32 kw_offset;
1237 scm_t_bits kw_bits;
1238 SCM kw;
1239 char allow_other_keys, has_rest;
1240
20b1b913 1241 UNPACK_24 (op, nreq);
510ca126
AW
1242 allow_other_keys = ip[1] & 0x1;
1243 has_rest = ip[1] & 0x2;
20b1b913
AW
1244 UNPACK_24 (ip[1], nreq_and_opt);
1245 UNPACK_24 (ip[2], ntotal);
510ca126
AW
1246 kw_offset = ip[3];
1247 kw_bits = (scm_t_bits) (ip + kw_offset);
1248 VM_ASSERT (!(kw_bits & 0x7), abort());
1249 kw = SCM_PACK (kw_bits);
1250
1251 nargs = FRAME_LOCALS_COUNT ();
1252
1253 /* look in optionals for first keyword or last positional */
1254 /* starting after the last required positional arg */
1255 npositional = nreq;
1256 while (/* while we have args */
1257 npositional < nargs
1258 /* and we still have positionals to fill */
1259 && npositional < nreq_and_opt
1260 /* and we haven't reached a keyword yet */
1261 && !scm_is_keyword (LOCAL_REF (npositional)))
1262 /* bind this optional arg (by leaving it in place) */
1263 npositional++;
1264 nkw = nargs - npositional;
1265 /* shuffle non-positional arguments above ntotal */
1266 ALLOC_FRAME (ntotal + nkw);
1267 n = nkw;
1268 while (n--)
1269 LOCAL_SET (ntotal + n, LOCAL_REF (npositional + n));
1270 /* and fill optionals & keyword args with SCM_UNDEFINED */
1271 n = npositional;
1272 while (n < ntotal)
1273 LOCAL_SET (n++, SCM_UNDEFINED);
1274
1275 VM_ASSERT (has_rest || (nkw % 2) == 0,
73fc4e73 1276 vm_error_kwargs_length_not_even (LOCAL_REF (0)));
510ca126
AW
1277
1278 /* Now bind keywords, in the order given. */
1279 for (n = 0; n < nkw; n++)
1280 if (scm_is_keyword (LOCAL_REF (ntotal + n)))
1281 {
1282 SCM walk;
1283 for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk))
1284 if (scm_is_eq (SCM_CAAR (walk), LOCAL_REF (ntotal + n)))
1285 {
1286 SCM si = SCM_CDAR (walk);
1287 LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32 (si),
1288 LOCAL_REF (ntotal + n + 1));
1289 break;
1290 }
1291 VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
73fc4e73 1292 vm_error_kwargs_unrecognized_keyword (LOCAL_REF (0),
28d5d253 1293 LOCAL_REF (ntotal + n)));
510ca126
AW
1294 n++;
1295 }
1296 else
73fc4e73 1297 VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (LOCAL_REF (0),
28d5d253 1298 LOCAL_REF (ntotal + n)));
510ca126
AW
1299
1300 if (has_rest)
1301 {
1302 SCM rest = SCM_EOL;
1303 n = nkw;
1304 while (n--)
aef1fcf9 1305 rest = scm_inline_cons (thread, LOCAL_REF (ntotal + n), rest);
510ca126
AW
1306 LOCAL_SET (nreq_and_opt, rest);
1307 }
1308
1309 RESET_FRAME (ntotal);
1310
1311 NEXT (4);
1312 }
1313
1314 /* bind-rest dst:24
1315 *
1316 * Collect any arguments at or above DST into a list, and store that
1317 * list at DST.
1318 */
b3ae2b50 1319 VM_DEFINE_OP (29, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
510ca126
AW
1320 {
1321 scm_t_uint32 dst, nargs;
1322 SCM rest = SCM_EOL;
1323
20b1b913 1324 UNPACK_24 (op, dst);
510ca126
AW
1325 nargs = FRAME_LOCALS_COUNT ();
1326
234155e3 1327 if (nargs <= dst)
510ca126 1328 {
234155e3
AW
1329 ALLOC_FRAME (dst + 1);
1330 while (nargs < dst)
1331 LOCAL_SET (nargs++, SCM_UNDEFINED);
510ca126 1332 }
234155e3
AW
1333 else
1334 {
1335 while (nargs-- > dst)
1336 {
aef1fcf9 1337 rest = scm_inline_cons (thread, LOCAL_REF (nargs), rest);
234155e3
AW
1338 LOCAL_SET (nargs, SCM_UNDEFINED);
1339 }
510ca126 1340
234155e3
AW
1341 RESET_FRAME (dst + 1);
1342 }
510ca126 1343
234155e3 1344 LOCAL_SET (dst, rest);
510ca126
AW
1345
1346 NEXT (1);
1347 }
1348
510ca126
AW
1349
1350 \f
1351
1352 /*
1353 * Branching instructions
1354 */
1355
1356 /* br offset:24
1357 *
1358 * Add OFFSET, a signed 24-bit number, to the current instruction
1359 * pointer.
1360 */
b3ae2b50 1361 VM_DEFINE_OP (30, br, "br", OP1 (U8_L24))
510ca126
AW
1362 {
1363 scm_t_int32 offset = op;
1364 offset >>= 8; /* Sign-extending shift. */
fcd3c8cc
AW
1365 if (offset <= 0)
1366 VM_HANDLE_INTERRUPTS;
510ca126
AW
1367 NEXT (offset);
1368 }
1369
1370 /* br-if-true test:24 invert:1 _:7 offset:24
1371 *
1372 * If the value in TEST is true for the purposes of Scheme, add
1373 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1374 */
b3ae2b50 1375 VM_DEFINE_OP (31, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1376 {
1377 BR_UNARY (x, scm_is_true (x));
1378 }
1379
1380 /* br-if-null test:24 invert:1 _:7 offset:24
1381 *
1382 * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
1383 * signed 24-bit number, to the current instruction pointer.
1384 */
b3ae2b50 1385 VM_DEFINE_OP (32, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1386 {
1387 BR_UNARY (x, scm_is_null (x));
1388 }
1389
1390 /* br-if-nil test:24 invert:1 _:7 offset:24
1391 *
1392 * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
1393 * number, to the current instruction pointer.
1394 */
b3ae2b50 1395 VM_DEFINE_OP (33, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1396 {
1397 BR_UNARY (x, scm_is_lisp_false (x));
1398 }
1399
1400 /* br-if-pair test:24 invert:1 _:7 offset:24
1401 *
1402 * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
1403 * to the current instruction pointer.
1404 */
b3ae2b50 1405 VM_DEFINE_OP (34, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1406 {
1407 BR_UNARY (x, scm_is_pair (x));
1408 }
1409
1410 /* br-if-struct test:24 invert:1 _:7 offset:24
1411 *
1412 * If the value in TEST is a struct, add OFFSET, a signed 24-bit
1413 * number, to the current instruction pointer.
1414 */
b3ae2b50 1415 VM_DEFINE_OP (35, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1416 {
1417 BR_UNARY (x, SCM_STRUCTP (x));
1418 }
1419
1420 /* br-if-char test:24 invert:1 _:7 offset:24
1421 *
1422 * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
1423 * to the current instruction pointer.
1424 */
b3ae2b50 1425 VM_DEFINE_OP (36, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
510ca126
AW
1426 {
1427 BR_UNARY (x, SCM_CHARP (x));
1428 }
1429
1430 /* br-if-tc7 test:24 invert:1 tc7:7 offset:24
1431 *
1432 * If the value in TEST has the TC7 given in the second word, add
1433 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1434 */
b3ae2b50 1435 VM_DEFINE_OP (37, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
510ca126
AW
1436 {
1437 BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
1438 }
1439
1440 /* br-if-eq a:12 b:12 invert:1 _:7 offset:24
1441 *
1442 * If the value in A is eq? to the value in B, add OFFSET, a signed
1443 * 24-bit number, to the current instruction pointer.
1444 */
b3ae2b50 1445 VM_DEFINE_OP (38, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1446 {
1447 BR_BINARY (x, y, scm_is_eq (x, y));
1448 }
1449
1450 /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24
1451 *
1452 * If the value in A is eqv? to the value in B, add OFFSET, a signed
1453 * 24-bit number, to the current instruction pointer.
1454 */
b3ae2b50 1455 VM_DEFINE_OP (39, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1456 {
1457 BR_BINARY (x, y,
1458 scm_is_eq (x, y)
1459 || (SCM_NIMP (x) && SCM_NIMP (y)
1460 && scm_is_true (scm_eqv_p (x, y))));
1461 }
1462
af95414f 1463 // FIXME: remove, have compiler inline eqv test instead
510ca126
AW
1464 /* br-if-equal a:12 b:12 invert:1 _:7 offset:24
1465 *
1466 * If the value in A is equal? to the value in B, add OFFSET, a signed
1467 * 24-bit number, to the current instruction pointer.
1468 */
4a1ce016
AW
1469 // FIXME: Should sync_ip before calling out and cache_fp before coming
1470 // back! Another reason to remove this opcode!
b3ae2b50 1471 VM_DEFINE_OP (40, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1472 {
1473 BR_BINARY (x, y,
1474 scm_is_eq (x, y)
1475 || (SCM_NIMP (x) && SCM_NIMP (y)
1476 && scm_is_true (scm_equal_p (x, y))));
1477 }
1478
af95414f 1479 /* br-if-= a:12 b:12 invert:1 _:7 offset:24
510ca126
AW
1480 *
1481 * If the value in A is = to the value in B, add OFFSET, a signed
1482 * 24-bit number, to the current instruction pointer.
1483 */
b3ae2b50 1484 VM_DEFINE_OP (41, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1485 {
1486 BR_ARITHMETIC (==, scm_num_eq_p);
1487 }
1488
02f9d496 1489 /* br-if-< a:12 b:12 invert:1 _:7 offset:24
510ca126
AW
1490 *
1491 * If the value in A is < to the value in B, add OFFSET, a signed
1492 * 24-bit number, to the current instruction pointer.
1493 */
b3ae2b50 1494 VM_DEFINE_OP (42, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1495 {
1496 BR_ARITHMETIC (<, scm_less_p);
1497 }
1498
02f9d496 1499 /* br-if-<= a:12 b:12 invert:1 _:7 offset:24
510ca126
AW
1500 *
1501 * If the value in A is <= to the value in B, add OFFSET, a signed
1502 * 24-bit number, to the current instruction pointer.
1503 */
b3ae2b50 1504 VM_DEFINE_OP (43, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
510ca126
AW
1505 {
1506 BR_ARITHMETIC (<=, scm_leq_p);
1507 }
1508
510ca126
AW
1509
1510 \f
1511
1512 /*
1513 * Lexical binding instructions
1514 */
1515
1516 /* mov dst:12 src:12
1517 *
1518 * Copy a value from one local slot to another.
1519 */
b3ae2b50 1520 VM_DEFINE_OP (44, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
1521 {
1522 scm_t_uint16 dst;
1523 scm_t_uint16 src;
1524
20b1b913 1525 UNPACK_12_12 (op, dst, src);
510ca126
AW
1526 LOCAL_SET (dst, LOCAL_REF (src));
1527
1528 NEXT (1);
1529 }
1530
1531 /* long-mov dst:24 _:8 src:24
1532 *
1533 * Copy a value from one local slot to another.
1534 */
b3ae2b50 1535 VM_DEFINE_OP (45, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
510ca126
AW
1536 {
1537 scm_t_uint32 dst;
1538 scm_t_uint32 src;
1539
20b1b913
AW
1540 UNPACK_24 (op, dst);
1541 UNPACK_24 (ip[1], src);
510ca126
AW
1542 LOCAL_SET (dst, LOCAL_REF (src));
1543
1544 NEXT (2);
1545 }
1546
1547 /* box dst:12 src:12
1548 *
1549 * Create a new variable holding SRC, and place it in DST.
1550 */
b3ae2b50 1551 VM_DEFINE_OP (46, box, "box", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
1552 {
1553 scm_t_uint16 dst, src;
20b1b913 1554 UNPACK_12_12 (op, dst, src);
aef1fcf9
AW
1555 LOCAL_SET (dst, scm_inline_cell (thread, scm_tc7_variable,
1556 SCM_UNPACK (LOCAL_REF (src))));
510ca126
AW
1557 NEXT (1);
1558 }
1559
510ca126
AW
1560 /* box-ref dst:12 src:12
1561 *
1562 * Unpack the variable at SRC into DST, asserting that the variable is
1563 * actually bound.
1564 */
b3ae2b50 1565 VM_DEFINE_OP (47, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
1566 {
1567 scm_t_uint16 dst, src;
1568 SCM var;
20b1b913 1569 UNPACK_12_12 (op, dst, src);
510ca126 1570 var = LOCAL_REF (src);
4f406fea
AW
1571 VM_ASSERT (SCM_VARIABLEP (var),
1572 vm_error_not_a_variable ("variable-ref", var));
73fc4e73 1573 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var));
510ca126
AW
1574 LOCAL_SET (dst, VARIABLE_REF (var));
1575 NEXT (1);
1576 }
1577
1578 /* box-set! dst:12 src:12
1579 *
1580 * Set the contents of the variable at DST to SET.
1581 */
b3ae2b50 1582 VM_DEFINE_OP (48, box_set, "box-set!", OP1 (U8_U12_U12))
510ca126
AW
1583 {
1584 scm_t_uint16 dst, src;
1585 SCM var;
20b1b913 1586 UNPACK_12_12 (op, dst, src);
510ca126 1587 var = LOCAL_REF (dst);
4f406fea
AW
1588 VM_ASSERT (SCM_VARIABLEP (var),
1589 vm_error_not_a_variable ("variable-set!", var));
510ca126
AW
1590 VARIABLE_SET (var, LOCAL_REF (src));
1591 NEXT (1);
1592 }
1593
7396d216 1594 /* make-closure dst:24 offset:32 _:8 nfree:24
510ca126
AW
1595 *
1596 * Make a new closure, and write it to DST. The code for the closure
1597 * will be found at OFFSET words from the current IP. OFFSET is a
7396d216
AW
1598 * signed 32-bit integer. Space for NFREE free variables will be
1599 * allocated.
510ca126 1600 */
b3ae2b50 1601 VM_DEFINE_OP (49, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
510ca126
AW
1602 {
1603 scm_t_uint32 dst, nfree, n;
1604 scm_t_int32 offset;
1605 SCM closure;
1606
20b1b913 1607 UNPACK_24 (op, dst);
510ca126 1608 offset = ip[1];
20b1b913 1609 UNPACK_24 (ip[2], nfree);
510ca126
AW
1610
1611 // FIXME: Assert range of nfree?
aef1fcf9
AW
1612 closure = scm_inline_words (thread, scm_tc7_program | (nfree << 16),
1613 nfree + 2);
510ca126 1614 SCM_SET_CELL_WORD_1 (closure, ip + offset);
7396d216 1615 // FIXME: Elide these initializations?
510ca126 1616 for (n = 0; n < nfree; n++)
d798a895 1617 SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
510ca126 1618 LOCAL_SET (dst, closure);
7396d216 1619 NEXT (3);
510ca126
AW
1620 }
1621
7396d216 1622 /* free-ref dst:12 src:12 _:8 idx:24
510ca126 1623 *
7396d216 1624 * Load free variable IDX from the closure SRC into local slot DST.
510ca126 1625 */
b3ae2b50 1626 VM_DEFINE_OP (50, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
510ca126 1627 {
7396d216
AW
1628 scm_t_uint16 dst, src;
1629 scm_t_uint32 idx;
20b1b913
AW
1630 UNPACK_12_12 (op, dst, src);
1631 UNPACK_24 (ip[1], idx);
7396d216 1632 /* CHECK_FREE_VARIABLE (src); */
d798a895 1633 LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
7396d216
AW
1634 NEXT (2);
1635 }
510ca126 1636
02f9d496 1637 /* free-set! dst:12 src:12 _:8 idx:24
7396d216
AW
1638 *
1639 * Set free variable IDX from the closure DST to SRC.
1640 */
b3ae2b50 1641 VM_DEFINE_OP (51, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
7396d216
AW
1642 {
1643 scm_t_uint16 dst, src;
1644 scm_t_uint32 idx;
20b1b913
AW
1645 UNPACK_12_12 (op, dst, src);
1646 UNPACK_24 (ip[1], idx);
7396d216 1647 /* CHECK_FREE_VARIABLE (src); */
d798a895 1648 SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
7396d216 1649 NEXT (2);
510ca126
AW
1650 }
1651
1652
1653 \f
1654
1655 /*
1656 * Immediates and statically allocated non-immediates
1657 */
1658
1659 /* make-short-immediate dst:8 low-bits:16
1660 *
1661 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1662 * 0.
1663 */
b3ae2b50 1664 VM_DEFINE_OP (52, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
510ca126
AW
1665 {
1666 scm_t_uint8 dst;
1667 scm_t_bits val;
1668
20b1b913 1669 UNPACK_8_16 (op, dst, val);
510ca126
AW
1670 LOCAL_SET (dst, SCM_PACK (val));
1671 NEXT (1);
1672 }
1673
1674 /* make-long-immediate dst:24 low-bits:32
1675 *
1676 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1677 * 0.
1678 */
b7ee9e08 1679 VM_DEFINE_OP (53, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32) | OP_DST)
510ca126 1680 {
da60ba80 1681 scm_t_uint32 dst;
510ca126
AW
1682 scm_t_bits val;
1683
20b1b913 1684 UNPACK_24 (op, dst);
510ca126
AW
1685 val = ip[1];
1686 LOCAL_SET (dst, SCM_PACK (val));
1687 NEXT (2);
1688 }
1689
1690 /* make-long-long-immediate dst:24 high-bits:32 low-bits:32
1691 *
1692 * Make an immediate with HIGH-BITS and LOW-BITS.
1693 */
b3ae2b50 1694 VM_DEFINE_OP (54, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
510ca126 1695 {
da60ba80 1696 scm_t_uint32 dst;
510ca126
AW
1697 scm_t_bits val;
1698
20b1b913 1699 UNPACK_24 (op, dst);
510ca126
AW
1700#if SIZEOF_SCM_T_BITS > 4
1701 val = ip[1];
1702 val <<= 32;
1703 val |= ip[2];
1704#else
1705 ASSERT (ip[1] == 0);
1706 val = ip[2];
1707#endif
1708 LOCAL_SET (dst, SCM_PACK (val));
1709 NEXT (3);
1710 }
1711
1712 /* make-non-immediate dst:24 offset:32
1713 *
1714 * Load a pointer to statically allocated memory into DST. The
1715 * object's memory is will be found OFFSET 32-bit words away from the
1716 * current instruction pointer. OFFSET is a signed value. The
1717 * intention here is that the compiler would produce an object file
1718 * containing the words of a non-immediate object, and this
1719 * instruction creates a pointer to that memory, effectively
1720 * resurrecting that object.
1721 *
1722 * Whether the object is mutable or immutable depends on where it was
1723 * allocated by the compiler, and loaded by the loader.
1724 */
b3ae2b50 1725 VM_DEFINE_OP (55, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
510ca126
AW
1726 {
1727 scm_t_uint32 dst;
1728 scm_t_int32 offset;
1729 scm_t_uint32* loc;
1730 scm_t_bits unpacked;
1731
20b1b913 1732 UNPACK_24 (op, dst);
510ca126
AW
1733 offset = ip[1];
1734 loc = ip + offset;
1735 unpacked = (scm_t_bits) loc;
1736
1737 VM_ASSERT (!(unpacked & 0x7), abort());
1738
1739 LOCAL_SET (dst, SCM_PACK (unpacked));
1740
1741 NEXT (2);
1742 }
1743
1744 /* static-ref dst:24 offset:32
1745 *
1746 * Load a SCM value into DST. The SCM value will be fetched from
1747 * memory, OFFSET 32-bit words away from the current instruction
1748 * pointer. OFFSET is a signed value.
1749 *
1750 * The intention is for this instruction to be used to load constants
1751 * that the compiler is unable to statically allocate, like symbols.
1752 * These values would be initialized when the object file loads.
1753 */
b7ee9e08 1754 VM_DEFINE_OP (56, static_ref, "static-ref", OP2 (U8_U24, S32) | OP_DST)
510ca126
AW
1755 {
1756 scm_t_uint32 dst;
1757 scm_t_int32 offset;
1758 scm_t_uint32* loc;
1759 scm_t_uintptr loc_bits;
1760
20b1b913 1761 UNPACK_24 (op, dst);
510ca126
AW
1762 offset = ip[1];
1763 loc = ip + offset;
1764 loc_bits = (scm_t_uintptr) loc;
1765 VM_ASSERT (ALIGNED_P (loc, SCM), abort());
1766
1767 LOCAL_SET (dst, *((SCM *) loc_bits));
1768
1769 NEXT (2);
1770 }
1771
1772 /* static-set! src:24 offset:32
1773 *
1774 * Store a SCM value into memory, OFFSET 32-bit words away from the
1775 * current instruction pointer. OFFSET is a signed value.
1776 */
b3ae2b50 1777 VM_DEFINE_OP (57, static_set, "static-set!", OP2 (U8_U24, LO32))
510ca126
AW
1778 {
1779 scm_t_uint32 src;
1780 scm_t_int32 offset;
1781 scm_t_uint32* loc;
1782
20b1b913 1783 UNPACK_24 (op, src);
510ca126
AW
1784 offset = ip[1];
1785 loc = ip + offset;
1786 VM_ASSERT (ALIGNED_P (loc, SCM), abort());
1787
1788 *((SCM *) loc) = LOCAL_REF (src);
1789
1790 NEXT (2);
1791 }
1792
2ab2a10d 1793 /* static-patch! _:24 dst-offset:32 src-offset:32
510ca126 1794 *
2ab2a10d
AW
1795 * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
1796 * are signed 32-bit values, indicating a memory address as a number
1797 * of 32-bit words away from the current instruction pointer.
510ca126 1798 */
b3ae2b50 1799 VM_DEFINE_OP (58, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32))
510ca126 1800 {
2ab2a10d
AW
1801 scm_t_int32 dst_offset, src_offset;
1802 void *src;
1803 void** dst_loc;
510ca126 1804
2ab2a10d
AW
1805 dst_offset = ip[1];
1806 src_offset = ip[2];
510ca126 1807
2ab2a10d
AW
1808 dst_loc = (void **) (ip + dst_offset);
1809 src = ip + src_offset;
1810 VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
510ca126 1811
2ab2a10d
AW
1812 *dst_loc = src;
1813
1814 NEXT (3);
510ca126
AW
1815 }
1816
1817 \f
1818
1819 /*
1820 * Mutable top-level bindings
1821 */
1822
1823 /* There are three slightly different ways to resolve toplevel
1824 variables.
1825
1826 1. A toplevel reference outside of a function. These need to be
1827 looked up when the expression is evaluated -- no later, and no
1828 before. They are looked up relative to the module that is
1829 current when the expression is evaluated. For example:
1830
1831 (if (foo) a b)
1832
1833 The "resolve" instruction resolves the variable (box), and then
1834 access is via box-ref or box-set!.
1835
1836 2. A toplevel reference inside a function. These are looked up
1837 relative to the module that was current when the function was
1838 defined. Unlike code at the toplevel, which is usually run only
1839 once, these bindings benefit from memoized lookup, in which the
1840 variable resulting from the lookup is cached in the function.
1841
1842 (lambda () (if (foo) a b))
1843
af95414f
AW
1844 The toplevel-box instruction is equivalent to "resolve", but
1845 caches the resulting variable in statically allocated memory.
510ca126
AW
1846
1847 3. A reference to an identifier with respect to a particular
1848 module. This can happen for primitive references, and
af95414f
AW
1849 references residualized by macro expansions. These can always
1850 be cached. Use module-box for these.
510ca126
AW
1851 */
1852
1853 /* current-module dst:24
1854 *
1855 * Store the current module in DST.
1856 */
b3ae2b50 1857 VM_DEFINE_OP (59, current_module, "current-module", OP1 (U8_U24) | OP_DST)
510ca126
AW
1858 {
1859 scm_t_uint32 dst;
1860
20b1b913 1861 UNPACK_24 (op, dst);
510ca126
AW
1862
1863 SYNC_IP ();
1864 LOCAL_SET (dst, scm_current_module ());
1865
1866 NEXT (1);
1867 }
1868
af95414f 1869 /* resolve dst:24 bound?:1 _:7 sym:24
510ca126 1870 *
af95414f
AW
1871 * Resolve SYM in the current module, and place the resulting variable
1872 * in DST.
510ca126 1873 */
b3ae2b50 1874 VM_DEFINE_OP (60, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
510ca126 1875 {
af95414f
AW
1876 scm_t_uint32 dst;
1877 scm_t_uint32 sym;
1878 SCM var;
510ca126 1879
20b1b913
AW
1880 UNPACK_24 (op, dst);
1881 UNPACK_24 (ip[1], sym);
510ca126
AW
1882
1883 SYNC_IP ();
af95414f 1884 var = scm_lookup (LOCAL_REF (sym));
4a1ce016 1885 CACHE_FP ();
af95414f 1886 if (ip[1] & 0x1)
73fc4e73 1887 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (LOCAL_REF (sym)));
af95414f 1888 LOCAL_SET (dst, var);
510ca126 1889
af95414f 1890 NEXT (2);
510ca126
AW
1891 }
1892
6165d812 1893 /* define! sym:12 val:12
510ca126
AW
1894 *
1895 * Look up a binding for SYM in the current module, creating it if
1896 * necessary. Set its value to VAL.
1897 */
b3ae2b50 1898 VM_DEFINE_OP (61, define, "define!", OP1 (U8_U12_U12))
510ca126
AW
1899 {
1900 scm_t_uint16 sym, val;
20b1b913 1901 UNPACK_12_12 (op, sym, val);
510ca126
AW
1902 SYNC_IP ();
1903 scm_define (LOCAL_REF (sym), LOCAL_REF (val));
4a1ce016 1904 CACHE_FP ();
510ca126
AW
1905 NEXT (1);
1906 }
1907
af95414f 1908 /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
510ca126
AW
1909 *
1910 * Load a SCM value. The SCM value will be fetched from memory,
1911 * VAR-OFFSET 32-bit words away from the current instruction pointer.
af95414f 1912 * VAR-OFFSET is a signed value. Up to here, toplevel-box is like
510ca126
AW
1913 * static-ref.
1914 *
af95414f
AW
1915 * Then, if the loaded value is a variable, it is placed in DST, and control
1916 * flow continues.
510ca126
AW
1917 *
1918 * Otherwise, we have to resolve the variable. In that case we load
1919 * the module from MOD-OFFSET, just as we loaded the variable.
1920 * Usually the module gets set when the closure is created. The name
1921 * is an offset to a symbol.
1922 *
af95414f
AW
1923 * We use the module and the symbol to resolve the variable, placing it in
1924 * DST, and caching the resolved variable so that we will hit the cache next
1925 * time.
510ca126 1926 */
b3ae2b50 1927 VM_DEFINE_OP (62, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
510ca126
AW
1928 {
1929 scm_t_uint32 dst;
1930 scm_t_int32 var_offset;
1931 scm_t_uint32* var_loc_u32;
1932 SCM *var_loc;
1933 SCM var;
1934
20b1b913 1935 UNPACK_24 (op, dst);
510ca126
AW
1936 var_offset = ip[1];
1937 var_loc_u32 = ip + var_offset;
1938 VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
1939 var_loc = (SCM *) var_loc_u32;
1940 var = *var_loc;
1941
1942 if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
1943 {
1944 SCM mod, sym;
1945 scm_t_int32 mod_offset = ip[2]; /* signed */
1946 scm_t_int32 sym_offset = ip[3]; /* signed */
1947 scm_t_uint32 *mod_loc = ip + mod_offset;
1948 scm_t_uint32 *sym_loc = ip + sym_offset;
1949
1950 SYNC_IP ();
1951
1952 VM_ASSERT (ALIGNED_P (mod_loc, SCM), abort());
1953 VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
1954
1955 mod = *((SCM *) mod_loc);
1956 sym = *((SCM *) sym_loc);
1957
e23f9e44
AW
1958 /* If the toplevel scope was captured before modules were
1959 booted, use the root module. */
1960 if (scm_is_false (mod))
1961 mod = scm_the_root_module ();
1962
510ca126 1963 var = scm_module_lookup (mod, sym);
4a1ce016 1964 CACHE_FP ();
af95414f 1965 if (ip[4] & 0x1)
73fc4e73 1966 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
510ca126
AW
1967
1968 *var_loc = var;
1969 }
1970
af95414f
AW
1971 LOCAL_SET (dst, var);
1972 NEXT (5);
510ca126
AW
1973 }
1974
af95414f 1975 /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
510ca126 1976 *
af95414f 1977 * Like toplevel-box, except MOD-OFFSET points at the name of a module
510ca126
AW
1978 * instead of the module itself.
1979 */
b3ae2b50 1980 VM_DEFINE_OP (63, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
510ca126
AW
1981 {
1982 scm_t_uint32 dst;
1983 scm_t_int32 var_offset;
1984 scm_t_uint32* var_loc_u32;
1985 SCM *var_loc;
1986 SCM var;
1987
20b1b913 1988 UNPACK_24 (op, dst);
510ca126
AW
1989 var_offset = ip[1];
1990 var_loc_u32 = ip + var_offset;
1991 VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
1992 var_loc = (SCM *) var_loc_u32;
1993 var = *var_loc;
1994
1995 if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
1996 {
1997 SCM modname, sym;
1998 scm_t_int32 modname_offset = ip[2]; /* signed */
1999 scm_t_int32 sym_offset = ip[3]; /* signed */
2000 scm_t_uint32 *modname_words = ip + modname_offset;
2001 scm_t_uint32 *sym_loc = ip + sym_offset;
2002
2003 SYNC_IP ();
2004
2005 VM_ASSERT (!(((scm_t_uintptr) modname_words) & 0x7), abort());
2006 VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
2007
2008 modname = SCM_PACK ((scm_t_bits) modname_words);
2009 sym = *((SCM *) sym_loc);
2010
e23f9e44
AW
2011 if (!scm_module_system_booted_p)
2012 {
698c55b0
AW
2013 ASSERT (scm_is_true
2014 scm_equal_p (modname,
2015 scm_list_2
2016 (SCM_BOOL_T,
2017 scm_from_utf8_symbol ("guile"))));
e23f9e44
AW
2018 var = scm_lookup (sym);
2019 }
2020 else if (scm_is_true (SCM_CAR (modname)))
510ca126
AW
2021 var = scm_public_lookup (SCM_CDR (modname), sym);
2022 else
2023 var = scm_private_lookup (SCM_CDR (modname), sym);
2024
4a1ce016
AW
2025 CACHE_FP ();
2026
af95414f 2027 if (ip[4] & 0x1)
73fc4e73 2028 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
510ca126
AW
2029
2030 *var_loc = var;
2031 }
2032
af95414f
AW
2033 LOCAL_SET (dst, var);
2034 NEXT (5);
510ca126
AW
2035 }
2036
2037 \f
2038
2039 /*
2040 * The dynamic environment
2041 */
2042
8d59d55e 2043 /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
510ca126
AW
2044 *
2045 * Push a new prompt on the dynamic stack, with a tag from TAG and a
2046 * handler at HANDLER-OFFSET words from the current IP. The handler
8d59d55e
AW
2047 * will expect a multiple-value return as if from a call with the
2048 * procedure at PROC-SLOT.
510ca126 2049 */
b3ae2b50 2050 VM_DEFINE_OP (64, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
510ca126 2051 {
8d59d55e 2052 scm_t_uint32 tag, proc_slot;
510ca126
AW
2053 scm_t_int32 offset;
2054 scm_t_uint8 escape_only_p;
2055 scm_t_dynstack_prompt_flags flags;
2056
20b1b913 2057 UNPACK_24 (op, tag);
8d59d55e 2058 escape_only_p = ip[1] & 0x1;
20b1b913 2059 UNPACK_24 (ip[1], proc_slot);
8d59d55e 2060 offset = ip[2];
510ca126
AW
2061 offset >>= 8; /* Sign extension */
2062
2063 /* Push the prompt onto the dynamic stack. */
2064 flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
aef1fcf9 2065 scm_dynstack_push_prompt (&thread->dynstack, flags,
510ca126 2066 LOCAL_REF (tag),
0bca90aa
AW
2067 fp - vp->stack_base,
2068 LOCAL_ADDRESS (proc_slot) - vp->stack_base,
9121d9f1 2069 ip + offset,
dd1c7dec 2070 registers);
8d59d55e 2071 NEXT (3);
510ca126 2072 }
510ca126
AW
2073
2074 /* wind winder:12 unwinder:12
2075 *
2076 * Push wind and unwind procedures onto the dynamic stack. Note that
2077 * neither are actually called; the compiler should emit calls to wind
2078 * and unwind for the normal dynamic-wind control flow. Also note that
2079 * the compiler should have inserted checks that they wind and unwind
2080 * procs are thunks, if it could not prove that to be the case.
2081 */
b3ae2b50 2082 VM_DEFINE_OP (65, wind, "wind", OP1 (U8_U12_U12))
510ca126
AW
2083 {
2084 scm_t_uint16 winder, unwinder;
20b1b913 2085 UNPACK_12_12 (op, winder, unwinder);
aef1fcf9 2086 scm_dynstack_push_dynwind (&thread->dynstack,
510ca126
AW
2087 LOCAL_REF (winder), LOCAL_REF (unwinder));
2088 NEXT (1);
2089 }
2090
510ca126
AW
2091 /* unwind _:24
2092 *
2093 * A normal exit from the dynamic extent of an expression. Pop the top
2094 * entry off of the dynamic stack.
2095 */
b3ae2b50 2096 VM_DEFINE_OP (66, unwind, "unwind", OP1 (U8_X24))
510ca126 2097 {
aef1fcf9 2098 scm_dynstack_pop (&thread->dynstack);
510ca126
AW
2099 NEXT (1);
2100 }
2101
98eaef1b 2102 /* push-fluid fluid:12 value:12
510ca126 2103 *
ddf0d7bb 2104 * Dynamically bind VALUE to FLUID.
510ca126 2105 */
b3ae2b50 2106 VM_DEFINE_OP (67, push_fluid, "push-fluid", OP1 (U8_U12_U12))
510ca126 2107 {
98eaef1b 2108 scm_t_uint32 fluid, value;
510ca126 2109
20b1b913 2110 UNPACK_12_12 (op, fluid, value);
510ca126 2111
aef1fcf9 2112 scm_dynstack_push_fluid (&thread->dynstack,
2a4ee2ac 2113 LOCAL_REF (fluid), LOCAL_REF (value),
aef1fcf9 2114 thread->dynamic_state);
98eaef1b 2115 NEXT (1);
510ca126 2116 }
510ca126 2117
98eaef1b 2118 /* pop-fluid _:24
510ca126 2119 *
ddf0d7bb
AW
2120 * Leave the dynamic extent of a with-fluid* expression, restoring the
2121 * fluid to its previous value.
510ca126 2122 */
b3ae2b50 2123 VM_DEFINE_OP (68, pop_fluid, "pop-fluid", OP1 (U8_X24))
510ca126
AW
2124 {
2125 /* This function must not allocate. */
aef1fcf9
AW
2126 scm_dynstack_unwind_fluid (&thread->dynstack,
2127 thread->dynamic_state);
510ca126
AW
2128 NEXT (1);
2129 }
2130
2131 /* fluid-ref dst:12 src:12
2132 *
2133 * Reference the fluid in SRC, and place the value in DST.
2134 */
b3ae2b50 2135 VM_DEFINE_OP (69, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2136 {
2137 scm_t_uint16 dst, src;
2138 size_t num;
2139 SCM fluid, fluids;
2140
20b1b913 2141 UNPACK_12_12 (op, dst, src);
510ca126 2142 fluid = LOCAL_REF (src);
aef1fcf9 2143 fluids = SCM_I_DYNAMIC_STATE_FLUIDS (thread->dynamic_state);
510ca126
AW
2144 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
2145 || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
2146 {
2147 /* Punt dynstate expansion and error handling to the C proc. */
2148 SYNC_IP ();
2149 LOCAL_SET (dst, scm_fluid_ref (fluid));
2150 }
2151 else
2152 {
2153 SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
2154 if (scm_is_eq (val, SCM_UNDEFINED))
2155 val = SCM_I_FLUID_DEFAULT (fluid);
2156 VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
73fc4e73 2157 vm_error_unbound_fluid (fluid));
510ca126
AW
2158 LOCAL_SET (dst, val);
2159 }
2160
2161 NEXT (1);
2162 }
2163
2164 /* fluid-set fluid:12 val:12
2165 *
2166 * Set the value of the fluid in DST to the value in SRC.
2167 */
b3ae2b50 2168 VM_DEFINE_OP (70, fluid_set, "fluid-set", OP1 (U8_U12_U12))
510ca126
AW
2169 {
2170 scm_t_uint16 a, b;
2171 size_t num;
2172 SCM fluid, fluids;
2173
20b1b913 2174 UNPACK_12_12 (op, a, b);
510ca126 2175 fluid = LOCAL_REF (a);
aef1fcf9 2176 fluids = SCM_I_DYNAMIC_STATE_FLUIDS (thread->dynamic_state);
510ca126
AW
2177 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
2178 || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
2179 {
2180 /* Punt dynstate expansion and error handling to the C proc. */
2181 SYNC_IP ();
2182 scm_fluid_set_x (fluid, LOCAL_REF (b));
2183 }
2184 else
2185 SCM_SIMPLE_VECTOR_SET (fluids, num, LOCAL_REF (b));
2186
2187 NEXT (1);
2188 }
2189
2190
2191 \f
2192
2193 /*
2194 * Strings, symbols, and keywords
2195 */
2196
2197 /* string-length dst:12 src:12
2198 *
2199 * Store the length of the string in SRC in DST.
2200 */
b3ae2b50 2201 VM_DEFINE_OP (71, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2202 {
2203 ARGS1 (str);
2204 if (SCM_LIKELY (scm_is_string (str)))
2205 RETURN (SCM_I_MAKINUM (scm_i_string_length (str)));
2206 else
2207 {
2208 SYNC_IP ();
2209 RETURN (scm_string_length (str));
2210 }
2211 }
2212
2213 /* string-ref dst:8 src:8 idx:8
2214 *
2215 * Fetch the character at position IDX in the string in SRC, and store
2216 * it in DST.
2217 */
b3ae2b50 2218 VM_DEFINE_OP (72, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2219 {
2220 scm_t_signed_bits i = 0;
2221 ARGS2 (str, idx);
2222 if (SCM_LIKELY (scm_is_string (str)
2223 && SCM_I_INUMP (idx)
2224 && ((i = SCM_I_INUM (idx)) >= 0)
2225 && i < scm_i_string_length (str)))
2226 RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, i)));
2227 else
2228 {
2229 SYNC_IP ();
2230 RETURN (scm_string_ref (str, idx));
2231 }
2232 }
2233
2234 /* No string-set! instruction, as there is no good fast path there. */
2235
ddf0d7bb 2236 /* string->number dst:12 src:12
510ca126
AW
2237 *
2238 * Parse a string in SRC to a number, and store in DST.
2239 */
b3ae2b50 2240 VM_DEFINE_OP (73, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2241 {
2242 scm_t_uint16 dst, src;
2243
20b1b913 2244 UNPACK_12_12 (op, dst, src);
510ca126
AW
2245 SYNC_IP ();
2246 LOCAL_SET (dst,
2247 scm_string_to_number (LOCAL_REF (src),
2248 SCM_UNDEFINED /* radix = 10 */));
2249 NEXT (1);
2250 }
2251
ddf0d7bb 2252 /* string->symbol dst:12 src:12
510ca126
AW
2253 *
2254 * Parse a string in SRC to a symbol, and store in DST.
2255 */
b3ae2b50 2256 VM_DEFINE_OP (74, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2257 {
2258 scm_t_uint16 dst, src;
2259
20b1b913 2260 UNPACK_12_12 (op, dst, src);
510ca126
AW
2261 SYNC_IP ();
2262 LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src)));
2263 NEXT (1);
2264 }
2265
2266 /* symbol->keyword dst:12 src:12
2267 *
2268 * Make a keyword from the symbol in SRC, and store it in DST.
2269 */
b3ae2b50 2270 VM_DEFINE_OP (75, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2271 {
2272 scm_t_uint16 dst, src;
20b1b913 2273 UNPACK_12_12 (op, dst, src);
510ca126
AW
2274 SYNC_IP ();
2275 LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
2276 NEXT (1);
2277 }
2278
2279 \f
2280
2281 /*
2282 * Pairs
2283 */
2284
2285 /* cons dst:8 car:8 cdr:8
2286 *
2287 * Cons CAR and CDR, and store the result in DST.
2288 */
b3ae2b50 2289 VM_DEFINE_OP (76, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2290 {
2291 ARGS2 (x, y);
aef1fcf9 2292 RETURN (scm_inline_cons (thread, x, y));
510ca126
AW
2293 }
2294
2295 /* car dst:12 src:12
2296 *
2297 * Place the car of SRC in DST.
2298 */
b3ae2b50 2299 VM_DEFINE_OP (77, car, "car", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2300 {
2301 ARGS1 (x);
2302 VM_VALIDATE_PAIR (x, "car");
2303 RETURN (SCM_CAR (x));
2304 }
2305
2306 /* cdr dst:12 src:12
2307 *
2308 * Place the cdr of SRC in DST.
2309 */
b3ae2b50 2310 VM_DEFINE_OP (78, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2311 {
2312 ARGS1 (x);
2313 VM_VALIDATE_PAIR (x, "cdr");
2314 RETURN (SCM_CDR (x));
2315 }
2316
2317 /* set-car! pair:12 car:12
2318 *
2319 * Set the car of DST to SRC.
2320 */
b3ae2b50 2321 VM_DEFINE_OP (79, set_car, "set-car!", OP1 (U8_U12_U12))
510ca126
AW
2322 {
2323 scm_t_uint16 a, b;
2324 SCM x, y;
20b1b913 2325 UNPACK_12_12 (op, a, b);
510ca126
AW
2326 x = LOCAL_REF (a);
2327 y = LOCAL_REF (b);
2328 VM_VALIDATE_PAIR (x, "set-car!");
2329 SCM_SETCAR (x, y);
2330 NEXT (1);
2331 }
2332
2333 /* set-cdr! pair:12 cdr:12
2334 *
2335 * Set the cdr of DST to SRC.
2336 */
b3ae2b50 2337 VM_DEFINE_OP (80, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
510ca126
AW
2338 {
2339 scm_t_uint16 a, b;
2340 SCM x, y;
20b1b913 2341 UNPACK_12_12 (op, a, b);
510ca126
AW
2342 x = LOCAL_REF (a);
2343 y = LOCAL_REF (b);
2344 VM_VALIDATE_PAIR (x, "set-car!");
2345 SCM_SETCDR (x, y);
2346 NEXT (1);
2347 }
2348
2349
2350 \f
2351
2352 /*
2353 * Numeric operations
2354 */
2355
2356 /* add dst:8 a:8 b:8
2357 *
2358 * Add A to B, and place the result in DST.
2359 */
b3ae2b50 2360 VM_DEFINE_OP (81, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2361 {
2362 BINARY_INTEGER_OP (+, scm_sum);
2363 }
2364
2365 /* add1 dst:12 src:12
2366 *
2367 * Add 1 to the value in SRC, and place the result in DST.
2368 */
b3ae2b50 2369 VM_DEFINE_OP (82, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2370 {
2371 ARGS1 (x);
2372
d2295ba5
MW
2373 /* Check for overflow. We must avoid overflow in the signed
2374 addition below, even if X is not an inum. */
2375 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) <= INUM_MAX - INUM_STEP))
510ca126
AW
2376 {
2377 SCM result;
2378
d2295ba5
MW
2379 /* Add 1 to the integer without untagging. */
2380 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) + INUM_STEP);
510ca126
AW
2381
2382 if (SCM_LIKELY (SCM_I_INUMP (result)))
2383 RETURN (result);
2384 }
2385
4a1ce016 2386 RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (1)));
510ca126
AW
2387 }
2388
2389 /* sub dst:8 a:8 b:8
2390 *
2391 * Subtract B from A, and place the result in DST.
2392 */
b3ae2b50 2393 VM_DEFINE_OP (83, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2394 {
2395 BINARY_INTEGER_OP (-, scm_difference);
2396 }
2397
2398 /* sub1 dst:12 src:12
2399 *
2400 * Subtract 1 from SRC, and place the result in DST.
2401 */
b3ae2b50 2402 VM_DEFINE_OP (84, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2403 {
2404 ARGS1 (x);
2405
d2295ba5
MW
2406 /* Check for overflow. We must avoid overflow in the signed
2407 subtraction below, even if X is not an inum. */
2408 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) >= INUM_MIN + INUM_STEP))
510ca126
AW
2409 {
2410 SCM result;
2411
d2295ba5
MW
2412 /* Substract 1 from the integer without untagging. */
2413 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) - INUM_STEP);
510ca126
AW
2414
2415 if (SCM_LIKELY (SCM_I_INUMP (result)))
2416 RETURN (result);
2417 }
2418
4a1ce016 2419 RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (1)));
510ca126
AW
2420 }
2421
2422 /* mul dst:8 a:8 b:8
2423 *
2424 * Multiply A and B, and place the result in DST.
2425 */
b3ae2b50 2426 VM_DEFINE_OP (85, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2427 {
2428 ARGS2 (x, y);
4a1ce016 2429 RETURN_EXP (scm_product (x, y));
510ca126
AW
2430 }
2431
2432 /* div dst:8 a:8 b:8
2433 *
2434 * Divide A by B, and place the result in DST.
2435 */
b3ae2b50 2436 VM_DEFINE_OP (86, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2437 {
2438 ARGS2 (x, y);
4a1ce016 2439 RETURN_EXP (scm_divide (x, y));
510ca126
AW
2440 }
2441
2442 /* quo dst:8 a:8 b:8
2443 *
2444 * Divide A by B, and place the quotient in DST.
2445 */
b3ae2b50 2446 VM_DEFINE_OP (87, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2447 {
2448 ARGS2 (x, y);
4a1ce016 2449 RETURN_EXP (scm_quotient (x, y));
510ca126
AW
2450 }
2451
2452 /* rem dst:8 a:8 b:8
2453 *
2454 * Divide A by B, and place the remainder in DST.
2455 */
b3ae2b50 2456 VM_DEFINE_OP (88, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2457 {
2458 ARGS2 (x, y);
4a1ce016 2459 RETURN_EXP (scm_remainder (x, y));
510ca126
AW
2460 }
2461
2462 /* mod dst:8 a:8 b:8
2463 *
2464 * Place the modulo of A by B in DST.
2465 */
b3ae2b50 2466 VM_DEFINE_OP (89, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2467 {
2468 ARGS2 (x, y);
4a1ce016 2469 RETURN_EXP (scm_modulo (x, y));
510ca126
AW
2470 }
2471
2472 /* ash dst:8 a:8 b:8
2473 *
2474 * Shift A arithmetically by B bits, and place the result in DST.
2475 */
b3ae2b50 2476 VM_DEFINE_OP (90, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2477 {
2478 ARGS2 (x, y);
2479 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2480 {
2481 if (SCM_I_INUM (y) < 0)
2482 /* Right shift, will be a fixnum. */
0bd65965
MW
2483 RETURN (SCM_I_MAKINUM
2484 (SCM_SRS (SCM_I_INUM (x),
2485 (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1)
2486 ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1)));
510ca126
AW
2487 else
2488 /* Left shift. See comments in scm_ash. */
2489 {
2490 scm_t_signed_bits nn, bits_to_shift;
2491
2492 nn = SCM_I_INUM (x);
2493 bits_to_shift = SCM_I_INUM (y);
2494
2495 if (bits_to_shift < SCM_I_FIXNUM_BIT-1
2496 && ((scm_t_bits)
2497 (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
2498 <= 1))
475772ea
MW
2499 RETURN (SCM_I_MAKINUM (nn < 0
2500 ? -(-nn << bits_to_shift)
2501 : (nn << bits_to_shift)));
510ca126
AW
2502 /* fall through */
2503 }
2504 /* fall through */
2505 }
4a1ce016 2506 RETURN_EXP (scm_ash (x, y));
510ca126
AW
2507 }
2508
2509 /* logand dst:8 a:8 b:8
2510 *
2511 * Place the bitwise AND of A and B into DST.
2512 */
b3ae2b50 2513 VM_DEFINE_OP (91, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2514 {
2515 ARGS2 (x, y);
2516 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
e7f64971
MW
2517 /* Compute bitwise AND without untagging */
2518 RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
4a1ce016 2519 RETURN_EXP (scm_logand (x, y));
510ca126
AW
2520 }
2521
2522 /* logior dst:8 a:8 b:8
2523 *
2524 * Place the bitwise inclusive OR of A with B in DST.
2525 */
b3ae2b50 2526 VM_DEFINE_OP (92, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2527 {
2528 ARGS2 (x, y);
2529 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
e7f64971
MW
2530 /* Compute bitwise OR without untagging */
2531 RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
4a1ce016 2532 RETURN_EXP (scm_logior (x, y));
510ca126
AW
2533 }
2534
2535 /* logxor dst:8 a:8 b:8
2536 *
2537 * Place the bitwise exclusive OR of A with B in DST.
2538 */
b3ae2b50 2539 VM_DEFINE_OP (93, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2540 {
2541 ARGS2 (x, y);
2542 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2543 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
4a1ce016 2544 RETURN_EXP (scm_logxor (x, y));
510ca126
AW
2545 }
2546
d38ca16e
AW
2547 /* make-vector dst:8 length:8 init:8
2548 *
2549 * Make a vector and write it to DST. The vector will have space for
2550 * LENGTH slots. They will be filled with the value in slot INIT.
2551 */
2552 VM_DEFINE_OP (94, make_vector, "make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
2553 {
2554 scm_t_uint8 dst, init, length;
2555
2556 UNPACK_8_8_8 (op, dst, length, init);
2557
2558 LOCAL_SET (dst, scm_make_vector (LOCAL_REF (length), LOCAL_REF (init)));
2559
2560 NEXT (1);
2561 }
2562
4c906ad5 2563 /* make-vector/immediate dst:8 length:8 init:8
607fe5a6
AW
2564 *
2565 * Make a short vector of known size and write it to DST. The vector
2566 * will have space for LENGTH slots, an immediate value. They will be
2567 * filled with the value in slot INIT.
2568 */
d38ca16e 2569 VM_DEFINE_OP (95, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
607fe5a6
AW
2570 {
2571 scm_t_uint8 dst, init;
2572 scm_t_int32 length, n;
2573 SCM val, vector;
2574
20b1b913 2575 UNPACK_8_8_8 (op, dst, length, init);
607fe5a6
AW
2576
2577 val = LOCAL_REF (init);
aef1fcf9
AW
2578 vector = scm_inline_words (thread, scm_tc7_vector | (length << 8),
2579 length + 1);
607fe5a6
AW
2580 for (n = 0; n < length; n++)
2581 SCM_SIMPLE_VECTOR_SET (vector, n, val);
2582 LOCAL_SET (dst, vector);
2583 NEXT (1);
2584 }
2585
510ca126
AW
2586 /* vector-length dst:12 src:12
2587 *
2588 * Store the length of the vector in SRC in DST.
2589 */
d38ca16e 2590 VM_DEFINE_OP (96, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2591 {
2592 ARGS1 (vect);
a32488ba
AW
2593 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2594 vm_error_not_a_vector ("vector-ref", vect));
2595 RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
510ca126
AW
2596 }
2597
2598 /* vector-ref dst:8 src:8 idx:8
2599 *
2600 * Fetch the item at position IDX in the vector in SRC, and store it
2601 * in DST.
2602 */
d38ca16e 2603 VM_DEFINE_OP (97, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2604 {
2605 scm_t_signed_bits i = 0;
2606 ARGS2 (vect, idx);
a32488ba
AW
2607 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2608 vm_error_not_a_vector ("vector-ref", vect));
2609 VM_ASSERT ((SCM_I_INUMP (idx)
2610 && ((i = SCM_I_INUM (idx)) >= 0)
2611 && i < SCM_I_VECTOR_LENGTH (vect)),
2612 vm_error_out_of_range ("vector-ref", idx));
2613 RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
510ca126
AW
2614 }
2615
4c906ad5 2616 /* vector-ref/immediate dst:8 src:8 idx:8
510ca126
AW
2617 *
2618 * Fill DST with the item IDX elements into the vector at SRC. Useful
2619 * for building data types using vectors.
2620 */
d38ca16e 2621 VM_DEFINE_OP (98, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2622 {
2623 scm_t_uint8 dst, src, idx;
2624 SCM v;
2625
20b1b913 2626 UNPACK_8_8_8 (op, dst, src, idx);
510ca126 2627 v = LOCAL_REF (src);
a32488ba
AW
2628 VM_ASSERT (SCM_I_IS_VECTOR (v),
2629 vm_error_not_a_vector ("vector-ref", v));
2630 VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (v),
2631 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
2632 LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
510ca126
AW
2633 NEXT (1);
2634 }
2635
2636 /* vector-set! dst:8 idx:8 src:8
2637 *
2638 * Store SRC into the vector DST at index IDX.
2639 */
d38ca16e 2640 VM_DEFINE_OP (99, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
2641 {
2642 scm_t_uint8 dst, idx_var, src;
2643 SCM vect, idx, val;
2644 scm_t_signed_bits i = 0;
2645
20b1b913 2646 UNPACK_8_8_8 (op, dst, idx_var, src);
510ca126
AW
2647 vect = LOCAL_REF (dst);
2648 idx = LOCAL_REF (idx_var);
2649 val = LOCAL_REF (src);
2650
a32488ba
AW
2651 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2652 vm_error_not_a_vector ("vector-ref", vect));
2653 VM_ASSERT ((SCM_I_INUMP (idx)
2654 && ((i = SCM_I_INUM (idx)) >= 0)
2655 && i < SCM_I_VECTOR_LENGTH (vect)),
2656 vm_error_out_of_range ("vector-ref", idx));
2657 SCM_I_VECTOR_WELTS (vect)[i] = val;
510ca126
AW
2658 NEXT (1);
2659 }
2660
4c906ad5 2661 /* vector-set!/immediate dst:8 idx:8 src:8
8ba3f20c
AW
2662 *
2663 * Store SRC into the vector DST at index IDX. Here IDX is an
2664 * immediate value.
2665 */
d38ca16e 2666 VM_DEFINE_OP (100, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
8ba3f20c
AW
2667 {
2668 scm_t_uint8 dst, idx, src;
2669 SCM vect, val;
2670
20b1b913 2671 UNPACK_8_8_8 (op, dst, idx, src);
8ba3f20c
AW
2672 vect = LOCAL_REF (dst);
2673 val = LOCAL_REF (src);
2674
a32488ba
AW
2675 VM_ASSERT (SCM_I_IS_VECTOR (vect),
2676 vm_error_not_a_vector ("vector-ref", vect));
2677 VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
2678 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
2679 SCM_I_VECTOR_WELTS (vect)[idx] = val;
8ba3f20c
AW
2680 NEXT (1);
2681 }
2682
510ca126
AW
2683
2684 \f
2685
2686 /*
2687 * Structs and GOOPS
2688 */
2689
2690 /* struct-vtable dst:12 src:12
2691 *
2692 * Store the vtable of SRC into DST.
2693 */
d38ca16e 2694 VM_DEFINE_OP (101, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2695 {
2696 ARGS1 (obj);
2697 VM_VALIDATE_STRUCT (obj, "struct_vtable");
2698 RETURN (SCM_STRUCT_VTABLE (obj));
2699 }
2700
4c906ad5 2701 /* allocate-struct/immediate dst:8 vtable:8 nfields:8
510ca126 2702 *
14d10292
AW
2703 * Allocate a new struct with VTABLE, and place it in DST. The struct
2704 * will be constructed with space for NFIELDS fields, which should
2705 * correspond to the field count of the VTABLE.
510ca126 2706 */
d38ca16e 2707 VM_DEFINE_OP (102, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126 2708 {
14d10292
AW
2709 scm_t_uint8 dst, vtable, nfields;
2710 SCM ret;
510ca126 2711
20b1b913 2712 UNPACK_8_8_8 (op, dst, vtable, nfields);
510ca126
AW
2713
2714 SYNC_IP ();
14d10292 2715 ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields));
510ca126 2716 LOCAL_SET (dst, ret);
14d10292
AW
2717
2718 NEXT (1);
510ca126 2719 }
510ca126 2720
4c906ad5 2721 /* struct-ref/immediate dst:8 src:8 idx:8
510ca126
AW
2722 *
2723 * Fetch the item at slot IDX in the struct in SRC, and store it
4c906ad5 2724 * in DST. IDX is an immediate unsigned 8-bit value.
510ca126 2725 */
d38ca16e 2726 VM_DEFINE_OP (103, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126 2727 {
4c906ad5
AW
2728 scm_t_uint8 dst, src, idx;
2729 SCM obj;
2730
20b1b913 2731 UNPACK_8_8_8 (op, dst, src, idx);
4c906ad5
AW
2732
2733 obj = LOCAL_REF (src);
510ca126
AW
2734
2735 if (SCM_LIKELY (SCM_STRUCTP (obj)
2736 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2737 SCM_VTABLE_FLAG_SIMPLE)
4c906ad5
AW
2738 && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
2739 scm_vtable_index_size)))
2740 RETURN (SCM_STRUCT_SLOT_REF (obj, idx));
510ca126
AW
2741
2742 SYNC_IP ();
4c906ad5 2743 RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx)));
510ca126
AW
2744 }
2745
4c906ad5 2746 /* struct-set!/immediate dst:8 idx:8 src:8
510ca126 2747 *
4c906ad5
AW
2748 * Store SRC into the struct DST at slot IDX. IDX is an immediate
2749 * unsigned 8-bit value.
510ca126 2750 */
d38ca16e 2751 VM_DEFINE_OP (104, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
510ca126
AW
2752 {
2753 scm_t_uint8 dst, idx, src;
4c906ad5
AW
2754 SCM obj, val;
2755
20b1b913 2756 UNPACK_8_8_8 (op, dst, idx, src);
4c906ad5 2757
510ca126 2758 obj = LOCAL_REF (dst);
510ca126 2759 val = LOCAL_REF (src);
4c906ad5 2760
510ca126
AW
2761 if (SCM_LIKELY (SCM_STRUCTP (obj)
2762 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2763 SCM_VTABLE_FLAG_SIMPLE)
2764 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2765 SCM_VTABLE_FLAG_SIMPLE_RW)
4c906ad5
AW
2766 && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
2767 scm_vtable_index_size)))
510ca126 2768 {
4c906ad5
AW
2769 SCM_STRUCT_SLOT_SET (obj, idx, val);
2770 NEXT (1);
510ca126
AW
2771 }
2772
2773 SYNC_IP ();
4c906ad5 2774 scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val);
510ca126
AW
2775 NEXT (1);
2776 }
2777
2778 /* class-of dst:12 type:12
2779 *
2780 * Store the vtable of SRC into DST.
2781 */
d38ca16e 2782 VM_DEFINE_OP (105, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
510ca126
AW
2783 {
2784 ARGS1 (obj);
2785 if (SCM_INSTANCEP (obj))
2786 RETURN (SCM_CLASS_OF (obj));
2787 SYNC_IP ();
2788 RETURN (scm_class_of (obj));
2789 }
2790
510ca126
AW
2791 \f
2792
2793 /*
2794 * Arrays, packed uniform arrays, and bytevectors.
2795 */
2796
2797 /* load-typed-array dst:8 type:8 shape:8 offset:32 len:32
2798 *
2799 * Load the contiguous typed array located at OFFSET 32-bit words away
2800 * from the instruction pointer, and store into DST. LEN is a byte
2801 * length. OFFSET is signed.
2802 */
d38ca16e 2803 VM_DEFINE_OP (106, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
510ca126
AW
2804 {
2805 scm_t_uint8 dst, type, shape;
2806 scm_t_int32 offset;
2807 scm_t_uint32 len;
2808
20b1b913 2809 UNPACK_8_8_8 (op, dst, type, shape);
510ca126
AW
2810 offset = ip[1];
2811 len = ip[2];
2812 SYNC_IP ();
2813 LOCAL_SET (dst, scm_from_contiguous_typed_array (LOCAL_REF (type),
2814 LOCAL_REF (shape),
2815 ip + offset, len));
2816 NEXT (3);
2817 }
2818
c09708f9 2819 /* make-array dst:8 type:8 fill:8 _:8 bounds:24
510ca126
AW
2820 *
2821 * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
2822 */
d38ca16e 2823 VM_DEFINE_OP (107, make_array, "make-array", OP2 (U8_U8_U8_U8, X8_U24) | OP_DST)
510ca126 2824 {
c09708f9
AW
2825 scm_t_uint8 dst, type, fill, bounds;
2826 UNPACK_8_8_8 (op, dst, type, fill);
2827 UNPACK_24 (ip[1], bounds);
510ca126
AW
2828 SYNC_IP ();
2829 LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill),
2830 LOCAL_REF (bounds)));
2831 NEXT (2);
2832 }
2833
2834 /* bv-u8-ref dst:8 src:8 idx:8
2835 * bv-s8-ref dst:8 src:8 idx:8
2836 * bv-u16-ref dst:8 src:8 idx:8
2837 * bv-s16-ref dst:8 src:8 idx:8
2838 * bv-u32-ref dst:8 src:8 idx:8
2839 * bv-s32-ref dst:8 src:8 idx:8
2840 * bv-u64-ref dst:8 src:8 idx:8
2841 * bv-s64-ref dst:8 src:8 idx:8
2842 * bv-f32-ref dst:8 src:8 idx:8
2843 * bv-f64-ref dst:8 src:8 idx:8
2844 *
2845 * Fetch the item at byte offset IDX in the bytevector SRC, and store
2846 * it in DST. All accesses use native endianness.
2847 */
2848#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
2849 do { \
2850 scm_t_signed_bits i; \
2851 const scm_t_ ## type *int_ptr; \
2852 ARGS2 (bv, idx); \
2853 \
2854 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2855 i = SCM_I_INUM (idx); \
2856 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2857 \
2858 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2859 && (i >= 0) \
2860 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2861 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2862 RETURN (SCM_I_MAKINUM (*int_ptr)); \
2863 else \
2864 { \
2865 SYNC_IP (); \
2866 RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx)); \
2867 } \
2868 } while (0)
2869
2870#define BV_INT_REF(stem, type, size) \
2871 do { \
2872 scm_t_signed_bits i; \
2873 const scm_t_ ## type *int_ptr; \
2874 ARGS2 (bv, idx); \
2875 \
2876 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2877 i = SCM_I_INUM (idx); \
2878 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2879 \
2880 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2881 && (i >= 0) \
2882 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2883 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2884 { \
2885 scm_t_ ## type x = *int_ptr; \
2886 if (SCM_FIXABLE (x)) \
2887 RETURN (SCM_I_MAKINUM (x)); \
2888 else \
2889 { \
2890 SYNC_IP (); \
2891 RETURN (scm_from_ ## type (x)); \
2892 } \
2893 } \
2894 else \
2895 { \
2896 SYNC_IP (); \
2897 RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx)); \
2898 } \
2899 } while (0)
2900
2901#define BV_FLOAT_REF(stem, fn_stem, type, size) \
2902 do { \
2903 scm_t_signed_bits i; \
2904 const type *float_ptr; \
2905 ARGS2 (bv, idx); \
2906 \
2907 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2908 i = SCM_I_INUM (idx); \
2909 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2910 \
2911 SYNC_IP (); \
2912 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2913 && (i >= 0) \
2914 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2915 && (ALIGNED_P (float_ptr, type)))) \
2916 RETURN (scm_from_double (*float_ptr)); \
2917 else \
2918 RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
2919 } while (0)
2920
d38ca16e 2921 VM_DEFINE_OP (108, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2922 BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
2923
d38ca16e 2924 VM_DEFINE_OP (109, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2925 BV_FIXABLE_INT_REF (s8, s8, int8, 1);
2926
d38ca16e 2927 VM_DEFINE_OP (110, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2928 BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
2929
d38ca16e 2930 VM_DEFINE_OP (111, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2931 BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
2932
d38ca16e 2933 VM_DEFINE_OP (112, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2934#if SIZEOF_VOID_P > 4
2935 BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
2936#else
2937 BV_INT_REF (u32, uint32, 4);
2938#endif
2939
d38ca16e 2940 VM_DEFINE_OP (113, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2941#if SIZEOF_VOID_P > 4
2942 BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
2943#else
2944 BV_INT_REF (s32, int32, 4);
2945#endif
2946
d38ca16e 2947 VM_DEFINE_OP (114, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2948 BV_INT_REF (u64, uint64, 8);
2949
d38ca16e 2950 VM_DEFINE_OP (115, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2951 BV_INT_REF (s64, int64, 8);
2952
d38ca16e 2953 VM_DEFINE_OP (116, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2954 BV_FLOAT_REF (f32, ieee_single, float, 4);
2955
d38ca16e 2956 VM_DEFINE_OP (117, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
510ca126
AW
2957 BV_FLOAT_REF (f64, ieee_double, double, 8);
2958
2959 /* bv-u8-set! dst:8 idx:8 src:8
2960 * bv-s8-set! dst:8 idx:8 src:8
2961 * bv-u16-set! dst:8 idx:8 src:8
2962 * bv-s16-set! dst:8 idx:8 src:8
2963 * bv-u32-set! dst:8 idx:8 src:8
2964 * bv-s32-set! dst:8 idx:8 src:8
2965 * bv-u64-set! dst:8 idx:8 src:8
2966 * bv-s64-set! dst:8 idx:8 src:8
2967 * bv-f32-set! dst:8 idx:8 src:8
2968 * bv-f64-set! dst:8 idx:8 src:8
2969 *
2970 * Store SRC into the bytevector DST at byte offset IDX. Multibyte
2971 * values are written using native endianness.
2972 */
2973#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
2974 do { \
2975 scm_t_uint8 dst, idx, src; \
2976 scm_t_signed_bits i, j = 0; \
2977 SCM bv, scm_idx, val; \
2978 scm_t_ ## type *int_ptr; \
2979 \
20b1b913 2980 UNPACK_8_8_8 (op, dst, idx, src); \
510ca126
AW
2981 bv = LOCAL_REF (dst); \
2982 scm_idx = LOCAL_REF (idx); \
2983 val = LOCAL_REF (src); \
ecbef966 2984 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
510ca126
AW
2985 i = SCM_I_INUM (scm_idx); \
2986 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2987 \
2988 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2989 && (i >= 0) \
2990 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2991 && (ALIGNED_P (int_ptr, scm_t_ ## type)) \
2992 && (SCM_I_INUMP (val)) \
2993 && ((j = SCM_I_INUM (val)) >= min) \
2994 && (j <= max))) \
2995 *int_ptr = (scm_t_ ## type) j; \
2996 else \
2997 { \
2998 SYNC_IP (); \
2999 scm_bytevector_ ## fn_stem ## _set_x (bv, scm_idx, val); \
3000 } \
3001 NEXT (1); \
3002 } while (0)
3003
3004#define BV_INT_SET(stem, type, size) \
3005 do { \
3006 scm_t_uint8 dst, idx, src; \
3007 scm_t_signed_bits i; \
3008 SCM bv, scm_idx, val; \
3009 scm_t_ ## type *int_ptr; \
3010 \
20b1b913 3011 UNPACK_8_8_8 (op, dst, idx, src); \
510ca126
AW
3012 bv = LOCAL_REF (dst); \
3013 scm_idx = LOCAL_REF (idx); \
3014 val = LOCAL_REF (src); \
ecbef966 3015 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
510ca126
AW
3016 i = SCM_I_INUM (scm_idx); \
3017 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
3018 \
3019 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
3020 && (i >= 0) \
3021 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
3022 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
3023 *int_ptr = scm_to_ ## type (val); \
3024 else \
3025 { \
3026 SYNC_IP (); \
3027 scm_bytevector_ ## stem ## _native_set_x (bv, scm_idx, val); \
3028 } \
3029 NEXT (1); \
3030 } while (0)
3031
3032#define BV_FLOAT_SET(stem, fn_stem, type, size) \
3033 do { \
3034 scm_t_uint8 dst, idx, src; \
3035 scm_t_signed_bits i; \
3036 SCM bv, scm_idx, val; \
3037 type *float_ptr; \
3038 \
20b1b913 3039 UNPACK_8_8_8 (op, dst, idx, src); \
510ca126
AW
3040 bv = LOCAL_REF (dst); \
3041 scm_idx = LOCAL_REF (idx); \
3042 val = LOCAL_REF (src); \
ecbef966 3043 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
510ca126
AW
3044 i = SCM_I_INUM (scm_idx); \
3045 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
3046 \
3047 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
3048 && (i >= 0) \
3049 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
3050 && (ALIGNED_P (float_ptr, type)))) \
3051 *float_ptr = scm_to_double (val); \
3052 else \
3053 { \
3054 SYNC_IP (); \
3055 scm_bytevector_ ## fn_stem ## _native_set_x (bv, scm_idx, val); \
3056 } \
3057 NEXT (1); \
3058 } while (0)
3059
d38ca16e 3060 VM_DEFINE_OP (118, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3061 BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
3062
d38ca16e 3063 VM_DEFINE_OP (119, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3064 BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
3065
d38ca16e 3066 VM_DEFINE_OP (120, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3067 BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
3068
d38ca16e 3069 VM_DEFINE_OP (121, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3070 BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
3071
d38ca16e 3072 VM_DEFINE_OP (122, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3073#if SIZEOF_VOID_P > 4
3074 BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
3075#else
3076 BV_INT_SET (u32, uint32, 4);
3077#endif
3078
d38ca16e 3079 VM_DEFINE_OP (123, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3080#if SIZEOF_VOID_P > 4
3081 BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
3082#else
3083 BV_INT_SET (s32, int32, 4);
3084#endif
3085
d38ca16e 3086 VM_DEFINE_OP (124, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3087 BV_INT_SET (u64, uint64, 8);
3088
d38ca16e 3089 VM_DEFINE_OP (125, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3090 BV_INT_SET (s64, int64, 8);
3091
d38ca16e 3092 VM_DEFINE_OP (126, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3093 BV_FLOAT_SET (f32, ieee_single, float, 4);
3094
d38ca16e 3095 VM_DEFINE_OP (127, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
510ca126
AW
3096 BV_FLOAT_SET (f64, ieee_double, double, 8);
3097
8c6206f3
AW
3098 /* br-if-logtest a:12 b:12 invert:1 _:7 offset:24
3099 *
3100 * If the exact integer in A has any bits in common with the exact
3101 * integer in B, add OFFSET, a signed 24-bit number, to the current
3102 * instruction pointer.
3103 */
3104 VM_DEFINE_OP (128, br_if_logtest, "br-if-logtest", OP2 (U8_U12_U12, B1_X7_L24))
3105 {
3106 BR_BINARY (x, y,
3107 ((SCM_I_INUMP (x) && SCM_I_INUMP (y))
3108 ? (SCM_UNPACK (x) & SCM_UNPACK (y) & ~scm_tc2_int)
3109 : scm_is_true (scm_logtest (x, y))));
3110 }
3111
27b3b5b9
AW
3112 /* FIXME: Move above */
3113
3114 /* allocate-struct dst:8 vtable:8 nfields:8
3115 *
3116 * Allocate a new struct with VTABLE, and place it in DST. The struct
3117 * will be constructed with space for NFIELDS fields, which should
3118 * correspond to the field count of the VTABLE.
3119 */
3120 VM_DEFINE_OP (129, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST)
3121 {
3122 scm_t_uint8 dst, vtable, nfields;
3123 SCM ret;
3124
3125 UNPACK_8_8_8 (op, dst, vtable, nfields);
3126
3127 SYNC_IP ();
3128 ret = scm_allocate_struct (LOCAL_REF (vtable), LOCAL_REF (nfields));
3129 LOCAL_SET (dst, ret);
3130
3131 NEXT (1);
3132 }
3133
3134 /* struct-ref dst:8 src:8 idx:8
3135 *
3136 * Fetch the item at slot IDX in the struct in SRC, and store it
3137 * in DST.
3138 */
3139 VM_DEFINE_OP (130, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
3140 {
3141 scm_t_uint8 dst, src, idx;
3142 SCM obj;
3143 SCM index;
3144
3145 UNPACK_8_8_8 (op, dst, src, idx);
3146
3147 obj = LOCAL_REF (src);
3148 index = LOCAL_REF (idx);
3149
3150 if (SCM_LIKELY (SCM_STRUCTP (obj)
3151 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
3152 SCM_VTABLE_FLAG_SIMPLE)
3153 && SCM_I_INUMP (index)
3154 && SCM_I_INUM (index) >= 0
3155 && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF
3156 (SCM_STRUCT_VTABLE (obj),
3157 scm_vtable_index_size))))
3158 RETURN (SCM_STRUCT_SLOT_REF (obj, SCM_I_INUM (index)));
3159
3160 SYNC_IP ();
3161 RETURN (scm_struct_ref (obj, index));
3162 }
3163
3164 /* struct-set! dst:8 idx:8 src:8
3165 *
3166 * Store SRC into the struct DST at slot IDX.
3167 */
3168 VM_DEFINE_OP (131, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
3169 {
3170 scm_t_uint8 dst, idx, src;
3171 SCM obj, val, index;
3172
3173 UNPACK_8_8_8 (op, dst, idx, src);
3174
3175 obj = LOCAL_REF (dst);
3176 val = LOCAL_REF (src);
3177 index = LOCAL_REF (idx);
3178
3179 if (SCM_LIKELY (SCM_STRUCTP (obj)
3180 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
3181 SCM_VTABLE_FLAG_SIMPLE)
3182 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
3183 SCM_VTABLE_FLAG_SIMPLE_RW)
3184 && SCM_I_INUMP (index)
3185 && SCM_I_INUM (index) >= 0
3186 && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF
3187 (SCM_STRUCT_VTABLE (obj),
3188 scm_vtable_index_size))))
3189 {
3190 SCM_STRUCT_SLOT_SET (obj, SCM_I_INUM (index), val);
3191 NEXT (1);
3192 }
3193
3194 SYNC_IP ();
3195 scm_struct_set_x (obj, index, val);
3196 NEXT (1);
3197 }
3198
d86682ba
AW
3199 VM_DEFINE_OP (132, unused_132, NULL, NOP)
3200 VM_DEFINE_OP (133, unused_133, NULL, NOP)
3201 VM_DEFINE_OP (134, unused_134, NULL, NOP)
3202 VM_DEFINE_OP (135, unused_135, NULL, NOP)
3203 VM_DEFINE_OP (136, unused_136, NULL, NOP)
3204 VM_DEFINE_OP (137, unused_137, NULL, NOP)
3205 VM_DEFINE_OP (138, unused_138, NULL, NOP)
3206 VM_DEFINE_OP (139, unused_139, NULL, NOP)
3207 VM_DEFINE_OP (140, unused_140, NULL, NOP)
3208 VM_DEFINE_OP (141, unused_141, NULL, NOP)
3209 VM_DEFINE_OP (142, unused_142, NULL, NOP)
3210 VM_DEFINE_OP (143, unused_143, NULL, NOP)
3211 VM_DEFINE_OP (144, unused_144, NULL, NOP)
3212 VM_DEFINE_OP (145, unused_145, NULL, NOP)
3213 VM_DEFINE_OP (146, unused_146, NULL, NOP)
3214 VM_DEFINE_OP (147, unused_147, NULL, NOP)
3215 VM_DEFINE_OP (148, unused_148, NULL, NOP)
3216 VM_DEFINE_OP (149, unused_149, NULL, NOP)
3217 VM_DEFINE_OP (150, unused_150, NULL, NOP)
3218 VM_DEFINE_OP (151, unused_151, NULL, NOP)
3219 VM_DEFINE_OP (152, unused_152, NULL, NOP)
3220 VM_DEFINE_OP (153, unused_153, NULL, NOP)
3221 VM_DEFINE_OP (154, unused_154, NULL, NOP)
3222 VM_DEFINE_OP (155, unused_155, NULL, NOP)
3223 VM_DEFINE_OP (156, unused_156, NULL, NOP)
3224 VM_DEFINE_OP (157, unused_157, NULL, NOP)
3225 VM_DEFINE_OP (158, unused_158, NULL, NOP)
3226 VM_DEFINE_OP (159, unused_159, NULL, NOP)
3227 VM_DEFINE_OP (160, unused_160, NULL, NOP)
3228 VM_DEFINE_OP (161, unused_161, NULL, NOP)
3229 VM_DEFINE_OP (162, unused_162, NULL, NOP)
3230 VM_DEFINE_OP (163, unused_163, NULL, NOP)
3231 VM_DEFINE_OP (164, unused_164, NULL, NOP)
3232 VM_DEFINE_OP (165, unused_165, NULL, NOP)
3233 VM_DEFINE_OP (166, unused_166, NULL, NOP)
3234 VM_DEFINE_OP (167, unused_167, NULL, NOP)
3235 VM_DEFINE_OP (168, unused_168, NULL, NOP)
3236 VM_DEFINE_OP (169, unused_169, NULL, NOP)
3237 VM_DEFINE_OP (170, unused_170, NULL, NOP)
3238 VM_DEFINE_OP (171, unused_171, NULL, NOP)
3239 VM_DEFINE_OP (172, unused_172, NULL, NOP)
3240 VM_DEFINE_OP (173, unused_173, NULL, NOP)
3241 VM_DEFINE_OP (174, unused_174, NULL, NOP)
3242 VM_DEFINE_OP (175, unused_175, NULL, NOP)
3243 VM_DEFINE_OP (176, unused_176, NULL, NOP)
3244 VM_DEFINE_OP (177, unused_177, NULL, NOP)
3245 VM_DEFINE_OP (178, unused_178, NULL, NOP)
3246 VM_DEFINE_OP (179, unused_179, NULL, NOP)
3247 VM_DEFINE_OP (180, unused_180, NULL, NOP)
3248 VM_DEFINE_OP (181, unused_181, NULL, NOP)
3249 VM_DEFINE_OP (182, unused_182, NULL, NOP)
3250 VM_DEFINE_OP (183, unused_183, NULL, NOP)
3251 VM_DEFINE_OP (184, unused_184, NULL, NOP)
3252 VM_DEFINE_OP (185, unused_185, NULL, NOP)
3253 VM_DEFINE_OP (186, unused_186, NULL, NOP)
3254 VM_DEFINE_OP (187, unused_187, NULL, NOP)
3255 VM_DEFINE_OP (188, unused_188, NULL, NOP)
3256 VM_DEFINE_OP (189, unused_189, NULL, NOP)
3257 VM_DEFINE_OP (190, unused_190, NULL, NOP)
3258 VM_DEFINE_OP (191, unused_191, NULL, NOP)
3259 VM_DEFINE_OP (192, unused_192, NULL, NOP)
3260 VM_DEFINE_OP (193, unused_193, NULL, NOP)
3261 VM_DEFINE_OP (194, unused_194, NULL, NOP)
3262 VM_DEFINE_OP (195, unused_195, NULL, NOP)
3263 VM_DEFINE_OP (196, unused_196, NULL, NOP)
3264 VM_DEFINE_OP (197, unused_197, NULL, NOP)
3265 VM_DEFINE_OP (198, unused_198, NULL, NOP)
3266 VM_DEFINE_OP (199, unused_199, NULL, NOP)
3267 VM_DEFINE_OP (200, unused_200, NULL, NOP)
3268 VM_DEFINE_OP (201, unused_201, NULL, NOP)
3269 VM_DEFINE_OP (202, unused_202, NULL, NOP)
3270 VM_DEFINE_OP (203, unused_203, NULL, NOP)
3271 VM_DEFINE_OP (204, unused_204, NULL, NOP)
3272 VM_DEFINE_OP (205, unused_205, NULL, NOP)
3273 VM_DEFINE_OP (206, unused_206, NULL, NOP)
3274 VM_DEFINE_OP (207, unused_207, NULL, NOP)
3275 VM_DEFINE_OP (208, unused_208, NULL, NOP)
3276 VM_DEFINE_OP (209, unused_209, NULL, NOP)
3277 VM_DEFINE_OP (210, unused_210, NULL, NOP)
3278 VM_DEFINE_OP (211, unused_211, NULL, NOP)
3279 VM_DEFINE_OP (212, unused_212, NULL, NOP)
3280 VM_DEFINE_OP (213, unused_213, NULL, NOP)
3281 VM_DEFINE_OP (214, unused_214, NULL, NOP)
3282 VM_DEFINE_OP (215, unused_215, NULL, NOP)
3283 VM_DEFINE_OP (216, unused_216, NULL, NOP)
3284 VM_DEFINE_OP (217, unused_217, NULL, NOP)
3285 VM_DEFINE_OP (218, unused_218, NULL, NOP)
3286 VM_DEFINE_OP (219, unused_219, NULL, NOP)
3287 VM_DEFINE_OP (220, unused_220, NULL, NOP)
3288 VM_DEFINE_OP (221, unused_221, NULL, NOP)
3289 VM_DEFINE_OP (222, unused_222, NULL, NOP)
3290 VM_DEFINE_OP (223, unused_223, NULL, NOP)
3291 VM_DEFINE_OP (224, unused_224, NULL, NOP)
3292 VM_DEFINE_OP (225, unused_225, NULL, NOP)
3293 VM_DEFINE_OP (226, unused_226, NULL, NOP)
3294 VM_DEFINE_OP (227, unused_227, NULL, NOP)
3295 VM_DEFINE_OP (228, unused_228, NULL, NOP)
3296 VM_DEFINE_OP (229, unused_229, NULL, NOP)
3297 VM_DEFINE_OP (230, unused_230, NULL, NOP)
3298 VM_DEFINE_OP (231, unused_231, NULL, NOP)
3299 VM_DEFINE_OP (232, unused_232, NULL, NOP)
3300 VM_DEFINE_OP (233, unused_233, NULL, NOP)
3301 VM_DEFINE_OP (234, unused_234, NULL, NOP)
3302 VM_DEFINE_OP (235, unused_235, NULL, NOP)
3303 VM_DEFINE_OP (236, unused_236, NULL, NOP)
3304 VM_DEFINE_OP (237, unused_237, NULL, NOP)
3305 VM_DEFINE_OP (238, unused_238, NULL, NOP)
3306 VM_DEFINE_OP (239, unused_239, NULL, NOP)
3307 VM_DEFINE_OP (240, unused_240, NULL, NOP)
3308 VM_DEFINE_OP (241, unused_241, NULL, NOP)
3309 VM_DEFINE_OP (242, unused_242, NULL, NOP)
3310 VM_DEFINE_OP (243, unused_243, NULL, NOP)
3311 VM_DEFINE_OP (244, unused_244, NULL, NOP)
3312 VM_DEFINE_OP (245, unused_245, NULL, NOP)
3313 VM_DEFINE_OP (246, unused_246, NULL, NOP)
3314 VM_DEFINE_OP (247, unused_247, NULL, NOP)
3315 VM_DEFINE_OP (248, unused_248, NULL, NOP)
3316 VM_DEFINE_OP (249, unused_249, NULL, NOP)
3317 VM_DEFINE_OP (250, unused_250, NULL, NOP)
3318 VM_DEFINE_OP (251, unused_251, NULL, NOP)
3319 VM_DEFINE_OP (252, unused_252, NULL, NOP)
3320 VM_DEFINE_OP (253, unused_253, NULL, NOP)
3321 VM_DEFINE_OP (254, unused_254, NULL, NOP)
3322 VM_DEFINE_OP (255, unused_255, NULL, NOP)
3323 {
3324 vm_error_bad_instruction (op);
3325 abort (); /* never reached */
3326 }
510ca126 3327
d86682ba 3328 END_DISPATCH_SWITCH;
510ca126
AW
3329}
3330
3331
3332#undef ABORT_CONTINUATION_HOOK
3333#undef ALIGNED_P
3334#undef APPLY_HOOK
3335#undef ARGS1
3336#undef ARGS2
3337#undef BEGIN_DISPATCH_SWITCH
3338#undef BINARY_INTEGER_OP
3339#undef BR_ARITHMETIC
3340#undef BR_BINARY
3341#undef BR_NARGS
3342#undef BR_UNARY
3343#undef BV_FIXABLE_INT_REF
3344#undef BV_FIXABLE_INT_SET
3345#undef BV_FLOAT_REF
3346#undef BV_FLOAT_SET
3347#undef BV_INT_REF
3348#undef BV_INT_SET
3349#undef CACHE_REGISTER
510ca126
AW
3350#undef END_DISPATCH_SWITCH
3351#undef FREE_VARIABLE_REF
3352#undef INIT
3353#undef INUM_MAX
3354#undef INUM_MIN
3355#undef LOCAL_REF
3356#undef LOCAL_SET
3357#undef NEXT
3358#undef NEXT_HOOK
3359#undef NEXT_JUMP
3360#undef POP_CONTINUATION_HOOK
3361#undef PUSH_CONTINUATION_HOOK
510ca126
AW
3362#undef RETURN
3363#undef RETURN_ONE_VALUE
3364#undef RETURN_VALUE_LIST
3365#undef RUN_HOOK
3366#undef RUN_HOOK0
ea0cd17d 3367#undef RUN_HOOK1
510ca126 3368#undef SYNC_IP
20b1b913
AW
3369#undef UNPACK_8_8_8
3370#undef UNPACK_8_16
3371#undef UNPACK_16_8
3372#undef UNPACK_12_12
3373#undef UNPACK_24
510ca126
AW
3374#undef VARIABLE_BOUNDP
3375#undef VARIABLE_REF
3376#undef VARIABLE_SET
3377#undef VM_CHECK_FREE_VARIABLE
3378#undef VM_CHECK_OBJECT
3379#undef VM_CHECK_UNDERFLOW
3380#undef VM_DEFINE_OP
3381#undef VM_INSTRUCTION_TO_LABEL
3382#undef VM_USE_HOOKS
3383#undef VM_VALIDATE_BYTEVECTOR
3384#undef VM_VALIDATE_PAIR
3385#undef VM_VALIDATE_STRUCT
3386
3387/*
3388(defun renumber-ops ()
3389 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
3390 (interactive "")
3391 (save-excursion
3392 (let ((counter -1)) (goto-char (point-min))
3393 (while (re-search-forward "^ *VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
3394 (replace-match
3395 (number-to-string (setq counter (1+ counter)))
3396 t t nil 1)))))
3397(renumber-ops)
3398*/
17e90c5e
KN
3399/*
3400 Local Variables:
3401 c-file-style: "gnu"
3402 End:
3403*/