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