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