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