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