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